Overview

This document explores video poker hands, using http://wizardofodds.com/games/video-poker/methodology/ as a template, and applying DataCamp_Insights_v001 materials where applicable. This document builds on the more salient components of the analysis in AdditionalCoding_v005.Rmd. In particular, the preparatory components are cached and saved, with a functional approach taken for assessing pay tables.

Analysis Approach

The Wizard of Odds suggests an 11-step approach to calculating the returns for a video poker pay table:

  1. Initialize arrays for discarding 0-5 cards
  2. Loop through all 52c5 hands, score them based on their poker value, then place them in the appropriate arrays (each of discard 0 through discard 5)
  3. Create the 134,459 non-duplicate starting hands possible (e.g., Ad Kh Tc 9c 3d is the same as As Kh Td 9d 3s), and assign it a weighting based on how much duplication it covers
  4. Lookup each of the 134,459 hands and score the discard 0 (hold 5) option
  5. Lookup every possible discard 1 (hold 4) option, find the EV in the discard 1 array and then subtract the outcome in the discard 0 array (cannot get back the same hand)
  6. Lookup every possible discard 2 (hold 3) option, find the EV in the discard 2 array and then subtract the outcomes in the discard 1 array and then add back the outcome in the discard 0 array (double-subtracted)
  7. Lookup every possible discard 3 (hold 2) option, find the EV in the discard 3 array and then subtract the outcomes in the discard 2 array and then add back the outcomes in the discard 1 array and then subtract out the outcome in the discard 0 array (typical set theory add/subtract)
  8. Lookup every possible discard 4 (hold 1) option, find the EV in the discard 4 array and then subtract the outcomes in the discard 3 array and then add back the outcomes in the discard 2 array and then subtract out the outcome in the discard 1 array and then add back the outcome in the discard 0 array (typical set theory add/subtract)
  9. Lookup every possible discard 5 (hold 0) option, find the EV in the discard 5 array and then subtract the outcomes in the discard 4 array and then add back the outcomes in the discard 3 array and then subtract out the outcome in the discard 2 array and then add back the outcome in the discard 1 array and then subtract out the outcome of the discard 0 array (typical set theory add/subtract)
  10. Calculate the EV of every possible decision, and assign the appropriate weightings
  11. Determine overall return, or other statistics of interest about the game

This program adapts the approach as follows:

Preparatory Work

Key libraries are sourced and global parameters set. In addition, all possible combinatorics are stored in an array, with functions declared to convert any given cards to an index. This component is not cached:

library(tidyr)
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.2.5
library(microbenchmark)
## Warning: package 'microbenchmark' was built under R version 3.2.5
startTime <- proc.time()
totStart <- startTime

# Declare overall game variables
nHandTypes <- 50  # Number of hand types supported
nScores <- 16  # Number of final scores supported - many hand types may map to the same score


proc.time() - startTime
##    user  system elapsed 
##       0       0       0
# Create a matrix to hold results for choose(n, k)
mtxCombin <- matrix(data=0L, nrow=52, ncol=5)
for (intCtr in 1:52) {
    for (intCtr2 in 1:5) {
        # Note that choose() is a guarded function where choose(n, k) returns 0 for k > n
        mtxCombin[intCtr, intCtr2] <- as.integer(choose(intCtr, intCtr2))
    }
}


idxCard1 <- function(c1) {
    # Just return yourself
    c1
}

idxCard2 <- function(c1, c2) {
    # Need to convert the C++ algorithm which is 0:51 to R which wants 1:52
    as.integer(  1 + mtxCombin[52, 2] - mtxCombin[53-c1, 2] + 
                     mtxCombin[52-c1, 1] - mtxCombin[53-c2, 1]
              ) 
}

idxCard3 <- function(c1, c2, c3) {
    # Need to convert the C++ algorithm which is 0:51 to R which wants 1:52
    as.integer(
        1 + mtxCombin[52, 3] - mtxCombin[53-c1, 3] +
            mtxCombin[52-c1, 2] - mtxCombin[53-c2, 2] +
            mtxCombin[52-c2, 1] - mtxCombin[53-c3, 1]
              )
}

idxCard4 <- function(c1, c2, c3, c4) {
    # Need to convert the C++ algorithm which is 0:51 to R which wants 1:52
    as.integer(
        1 + mtxCombin[52, 4] - mtxCombin[53-c1, 4] +
            mtxCombin[52-c1, 3] - mtxCombin[53-c2, 3] +
            mtxCombin[52-c2, 2] - mtxCombin[53-c3, 2] + 
            mtxCombin[52-c3, 1] - mtxCombin[53-c4, 1]
              )
}

idxCard5 <- function(c1, c2, c3, c4, c5) {
    # Need to convert the C++ algorithm which is 0:51 to R which wants 1:52
    as.integer(
        1 + mtxCombin[52, 5] - mtxCombin[53-c1, 5] +
            mtxCombin[52-c1, 4] - mtxCombin[53-c2, 4] +
            mtxCombin[52-c2, 3] - mtxCombin[53-c3, 3] + 
            mtxCombin[52-c3, 2] - mtxCombin[53-c4, 2] +
            mtxCombin[52-c4, 1] - mtxCombin[53-c5, 1]
             )
}

proc.time() - startTime
##    user  system elapsed 
##    0.01    0.00    0.01

Each of the 52c5 possible starting hands are created, with hand types declared. Of particular interest will be tracking the following, with results cached for time considerations:

  • Nothing (0)
  • Royal Flush (1)
  • Straight Flush (2)
  • Full House (3)
  • Flush (4)
  • Straight (5)
  • Trips (6)
  • Two Pair (7)
  • Pair AA (8)
  • Pair KK (9)
  • Pair QQ (10)
  • Pair JJ (11)
  • Pair TT (12)
  • Pair 22-99 (13)
  • AAAA with 2-4 (14)
  • AAAA with J-K (15)
  • AAAA with 5-T (16)
  • 2222/3333/4444 with A (17)
  • 2222/3333/4444 with 2-4 (18)
  • 2222/3333/4444 with J-K (19)
  • 2222/3333/4444 with 5-T (20)
  • JJJJ/QQQQ/KKKK with A (21)
  • JJJJ/QQQQ/KKKK with 2-4 (22)
  • JJJJ/QQQQ/KKKK with J-K (23)
  • JJJJ/QQQQ/KKKK with 5-T (24)
  • 5555-TTTT (25)
startTime <- proc.time()


# Create the 52c5 hands
aHands <- t(combn(1:52, 5))
str(aHands)
##  int [1:2598960, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
proc.time() - startTime
##    user  system elapsed 
##    2.65    0.03    2.72
findTypes <- function (aHands, retAll=FALSE) {
    
    # Find the ranks and suits
    aRanks <- 1 + (aHands-1) %% 13
    aSuits <- (aHands-1) %/% 13
    
    # Find the flushes
    aFlush <- aSuits[, 1] == aSuits[, 5]

    # Find the straights
    strMatrix <- matrix(data=0L, nrow=13, ncol=10)
    strMatrix[c(1, 10, 11, 12, 13), 1] <- 1L
    for (intCtr in 1:9) { strMatrix[intCtr:(intCtr+4), intCtr+1] <- 1L }

    aRankCount <- matrix(data=-1L, nrow=choose(52, 5), ncol=13)
    for (intCtr in 1:13) { aRankCount[, intCtr] <- rowSums(aRanks == intCtr) }

    # Find max and count of ranks (sufficient to determine quads, full houses, trips, two pair, and pair)
    aQuads <- rowSums(aRankCount == 4)
    aTrips <- rowSums(aRankCount == 3)
    aPairs <- rowSums(aRankCount == 2)
    aStraight <- rowSums( ((aRankCount == 1) %*% strMatrix) == 5)

    # Default is that a hand has nothing
    aType <- rep(0L, choose(52, 5))

    # Declare types for mainline (RF, SF, FH, FL, ST, 3K, 2P)
    aType[aFlush == 1 & aStraight == 1 & aRankCount[, 1] == 1 & 
              aRankCount[, 13] == 1] <- 1  # Royal Flush
    aType[aFlush == 1 & aStraight == 1 & 
              (aRankCount[, 1] == 0 | aRankCount[, 13] == 0)] <- 2  # Straight Flush
    aType[aTrips == 1 & aPairs == 1] <- 3  # Full House
    aType[aFlush == 1 & aStraight == 0] <- 4  # Flush
    aType[aFlush == 0 & aStraight == 1] <- 5  # Straight
    aType[aTrips == 1 & aPairs == 0] <- 6  # Trips
    aType[aPairs == 2] <- 7  # Two Pair

    # Declare types for pairs
    aType[aTrips == 0 & aPairs == 1 & aRankCount[, 1] == 2] <- 8  # Pair Aces
    aType[aTrips == 0 & aPairs == 1 & aRankCount[, 13] == 2] <- 9  # Pair Kings
    aType[aTrips == 0 & aPairs == 1 & aRankCount[, 12] == 2] <- 10  # Pair Queens
    aType[aTrips == 0 & aPairs == 1 & aRankCount[, 11] == 2] <- 11  # Pair Jacks
    aType[aTrips == 0 & aPairs == 1 & aRankCount[, 10] == 2] <- 12  # Pair Tens
    aType[aTrips == 0 & aPairs == 1 & !(aType %in% c(8, 9, 10, 11, 12))] <- 13  # Pair 22-99

    # Declare types for quads
    quadSubset <- aRankCount[aQuads == 1, ]
    quadType <- apply(quadSubset, 1, FUN=function(x) { c(which(x == 4), which(x == 1)) } )
    quadScore <- rep(-1L, ncol(quadType))

    quadScore[quadType[1, ] == 1 & quadType[2, ] %in% c(2, 3, 4)] <- 14  ## AAAA with 2-4
    quadScore[quadType[1, ] == 1 & quadType[2, ] %in% c(11, 12, 13)] <- 15  ## AAAA with J-K
    quadScore[quadType[1, ] == 1 & quadType[2, ] %in% c(5, 6, 7, 8, 9, 10)] <- 16  ## AAAA with 5-T

    quadScore[quadType[1, ] %in% c(2, 3, 4) & 
                  quadType[2, ] %in% c(1)] <- 17  ## 2222/3333/4444 with A
    quadScore[quadType[1, ] %in% c(2, 3, 4) & 
                  quadType[2, ] %in% c(2, 3, 4)] <- 18  ## 2222/3333/4444 with 2-4
    quadScore[quadType[1, ] %in% c(2, 3, 4) & 
                  quadType[2, ] %in% c(11, 12, 13)] <- 19  ## 2222/3333/4444 with J-K
    quadScore[quadType[1, ] %in% c(2, 3, 4) & 
                  quadType[2, ] %in% c(5, 6, 7, 8, 9, 10)] <- 20  ## 2222/3333/4444 with 5-T

    quadScore[quadType[1, ] %in% c(11, 12, 13) & 
                  quadType[2, ] %in% c(1)] <- 21  ## JJJJ/QQQQ/KKKK with A
    quadScore[quadType[1, ] %in% c(11, 12, 13) & 
                  quadType[2, ] %in% c(2, 3, 4)] <- 22  ## JJJJ/QQQQ/KKKK with 2-4
    quadScore[quadType[1, ] %in% c(11, 12, 13) & 
                  quadType[2, ] %in% c(11, 12, 13)] <- 23  ## JJJJ/QQQQ/KKKK with J-K
    quadScore[quadType[1, ] %in% c(11, 12, 13) & 
                  quadType[2, ] %in% c(5, 6, 7, 8, 9, 10)] <- 24  ## JJJJ/QQQQ/KKKK with 5-T

    quadScore[quadType[1, ] %in% c(5, 6, 7, 8, 9, 10)] <- 25  ## 5555/6666/7777/8888/9999/TTTT with any

    # Populate quad results in to aType
    aType[aQuads == 1] <- quadScore
    data.frame(type=aType) %>% group_by(type) %>% summarize(ct=n()) %>% print.data.frame()

    if (retAll) {
        list(aType=aType, 
             aRankCount=aRankCount,
             aRanks=aRanks,
             aSuits=aSuits,
             quadSubset=quadSubset,
             quadType=quadType,
             aFlush=aFlush,
             aPairs=aPairs,
             aQuads=aQuads,
             aStraight=aStraight,
             aTrips=aTrips
             )
    } else {
        list(aType=aType) 
    }
}


listType <- findTypes(aHands=aHands, retAll=FALSE)
##    type      ct
## 1     0 1302540
## 2     1       4
## 3     2      36
## 4     3    3744
## 5     4    5108
## 6     5   10200
## 7     6   54912
## 8     7  123552
## 9     8   84480
## 10    9   84480
## 11   10   84480
## 12   11   84480
## 13   12   84480
## 14   13  675840
## 15   14      12
## 16   15      12
## 17   16      24
## 18   17      12
## 19   18      24
## 20   19      36
## 21   20      72
## 22   21      12
## 23   22      36
## 24   23      24
## 25   24      72
## 26   25     288
aType <- listType$aType


proc.time() - startTime
##    user  system elapsed 
##   10.32    1.40   12.06

Further, each starting hand is assigned indices for keep0/discard5 down to keep5/discard0 . Note that hand types have not yet been converted to scores; this is simply the step for finding the relevant indices (cached for run-time optimization):

startTime <- proc.time()


getIndices <- function(nKeep, keyFun) {

    mtxKeep <- combn(1:5, nKeep)
    retResults <- matrix(data=-1L, nrow=nrow(aHands), ncol=ncol(mtxKeep))

    for (intCtr in 1:ncol(mtxKeep)) {
        thisKey <- mtxKeep[, intCtr, drop=TRUE]
        thisList <- lapply(seq_along(thisKey), FUN=function(x) { aHands[, thisKey[x]] } )
        if (length(thisList) == 5) {
            retResults[, intCtr] <- keyFun(thisList[[1]], thisList[[2]], thisList[[3]], 
                                           thisList[[4]], thisList[[5]]
                                           )
        } else if (length(thisList) == 4) {
            retResults[, intCtr] <- keyFun(thisList[[1]], thisList[[2]], 
                                           thisList[[3]], thisList[[4]]
                                           )
        } else if (length(thisList) == 3) {
            retResults[, intCtr] <- keyFun(thisList[[1]], thisList[[2]], thisList[[3]])
        } else if (length(thisList) == 2) {
            retResults[, intCtr] <- keyFun(thisList[[1]], thisList[[2]])
        } else if (length(thisList) == 1) {
            retResults[, intCtr] <- keyFun(thisList[[1]])
        } else { stop(paste0("Incorrect list length: ", length(thisList))) }
    }

    # Pass back the outcome
    retResults
    
}


mtxIndices <- matrix(data=-1L, nrow=nrow(aHands), ncol=32)

# Populate the keep-all
mtxIndices[, 1] <- getIndices(nKeep=5, keyFun=idxCard5)
proc.time() - startTime
##    user  system elapsed 
##    1.37    0.17    1.55
# Populate the keep-four
mtxIndices[, 2:6] <- getIndices(nKeep=4, keyFun=idxCard4)
proc.time() - startTime
##    user  system elapsed 
##    3.45    0.64    4.11
# Populate the keep-three
mtxIndices[, 7:16] <- getIndices(nKeep=3, keyFun=idxCard3)
proc.time() - startTime
##    user  system elapsed 
##    6.71    1.40    8.13
# Populate the keep-two
mtxIndices[, 17:26] <- getIndices(nKeep=2, keyFun=idxCard2)
proc.time() - startTime
##    user  system elapsed 
##    9.20    1.84   11.08
# Populate the keep-one
mtxIndices[, 27:31] <- getIndices(nKeep=1, keyFun=idxCard1)
proc.time() - startTime
##    user  system elapsed 
##    9.76    1.87   11.67
# Populate the keep-zero
mtxIndices[, 32] <- 0L


proc.time() - startTime
##    user  system elapsed 
##    9.80    1.87   11.70

The next step creates the 134,459 non-duplicate starting hands possible (e.g., Ad Kh Tc 9c 3d is the same as As Kh Td 9d 3s), and assigns each a weighting based on how much duplication it covers.

This is copied from v004/v005 which was adapted heavily from clever thinking at http://wizardofodds.com/games/video-poker/methodology/, using in order:

  • Four of a Kind (all that matters is what is the rank of the quad/kicker)
  • Full House (need to know ranks for A full of B, as well as whether B contains the fourth suit or not)
  • Trips (singletons can be all of fourth suit, one match and one fourth suit, no fourth suit/same, or no fourth suit/different)
  • Two Pair (suits matter for how much is in common between the two pairs, as well as the singleton)
  • Pair (many combinations for suits of the singletons)
  • Nothing (suits matter a great deal!)

This component is cached for run-time performance:

startTime <- proc.time()


# Quads are simple - there are 13 possible quads and 12 possible kickers
# Each hand can be captured once with a weight of 4 since the kicker will always match one suit
quadSmall <- matrix(data=0L, nrow=13*12, ncol=5)
quadWeight <- rep(4L, times=13*12)
curIdx <- 1

for (intCtr in 1:13) {
    for (intCtr2 in (1:13)[-intCtr]) {
        quadSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr+39, intCtr2))
        curIdx <- curIdx + 1
    }
}


# Full Houses are not too much more complex, though there are two suit pairing options for each
fhSmall <- matrix(data=0L, nrow=13*12*2, ncol=5)
fhWeight <- rep(12L, times=13*12*2)
curIdx <- 1

for (intCtr in 1:13) {
    for (intCtr2 in (1:13)[-intCtr]) {
        # First option has both pairs matching the suits of the trips
        fhSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr2+13))
        # Second option has one pair not matching the suits of the trips
        fhSmall[curIdx+1, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr2+39))
        curIdx <- curIdx + 2
    }
}


# Trips become a touch more complicated
# There is weight 24 for both singletons match different trips suits
# There is weight 12 for one singleton matches and the other does not
# There is weight 12 for both singletons match the same trips suit
# There is weight 4 for both singletons match each other but not any of the trips suits
tripSmall <- matrix(data=0L, nrow=13*choose(12, 2)*5, ncol=5)
tripWeight <- rep(c(24, 12, 12, 12, 4), times=13*choose(12,2))
curIdx <- 1

for (intCtr in 1:13) {
    intAvail <- (1:13)[-intCtr]
    for (intCtr2 in intAvail[-length(intAvail)]) {
        for (intCtr3 in intAvail[intAvail > intCtr2]) {
            # First option has both singletons matching a different trips suit
            tripSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr3+13))
            # Second option has singleton one matching a trips suit and singleton two not
            tripSmall[curIdx+1, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr3+39))
            # Third option has singleton two matching a trips suit and singleton one not
            tripSmall[curIdx+2, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2+39, intCtr3))
            # Fourth option has both singletons matching the same trips suit
            tripSmall[curIdx+3, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2, intCtr3))
            # Fifth option has both singletons failing to match a trips suit
            tripSmall[curIdx+4, ] <- sort(c(intCtr, intCtr+13, intCtr+26, intCtr2+39, intCtr3+39))
            # Increment the index by 5
            curIdx <- curIdx + 5
        }
    }
}


# Two Pair becomes even more complicated
# There is weight 12 for four suits across the two pair -- singleton matches pair #1 or pair #2
# There is weight 24 for each of one suit match across the two pair; singleton can be four suits
# There is weight 12 for the two pair having identical suits; once for the singleton matching, once for not
twoSmall <- matrix(data=0L, nrow=choose(13, 2)*11*8, ncol=5)
twoWeight <- rep(c(12, 12, 24, 24, 24, 24, 12, 12), times=choose(13, 2)*11)
curIdx <- 1

for (intCtr in 1:12) {
    for (intCtr2 in (intCtr+1):13) {
        for (intCtr3 in (1:13)[-c(intCtr, intCtr2)]) {
            
            # First option has all two pair cards being different suits
            twoSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr2+39, intCtr3))
            twoSmall[curIdx+1, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr2+39, intCtr3+26))
            
            # Second option has one matched suits in the two pair
            twoSmall[curIdx+2, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+26, intCtr3))
            twoSmall[curIdx+3, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+26, intCtr3+13))
            twoSmall[curIdx+4, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+26, intCtr3+26))
            twoSmall[curIdx+5, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+26, intCtr3+39))
            
            # Third option has fully matched suits across the two pair
            twoSmall[curIdx+6, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+13, intCtr3))
            twoSmall[curIdx+7, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr2+13, intCtr3+26))
            
            # Increment the index by 8
            curIdx <- curIdx + 8
        }
    }
}


# One Pair becomes even more complicated
# The pair is (obviously) two-suited; consider them to be 1 and 2; the game is in the singletons
# Weight 12 (2): Singletons all same suit, once matching to a pair suit, and once not
# Weight 12 (3): Singletons are suited 2-1, all matching to the pairs - 112, 121, 211
# Weight 24 (3): Singletons are suited 2-1, two matching to the pairs - 113, 131, 311
# Weight 24 (3): Singletons are suited 2-1, one matching to the pairs - 133, 313, 331 
# Weight 12 (3): Singletons are suited 2-1, none matching to the pairs - 344, 434, 443
# Weight 24 (3): Singletons are suited 1-1-1, two matching to the pairs - 123, 132, 312
# Weight 24 (3): Singletons are suited 1-1-1, one matching to the pairs - 134, 314, 341
pairSmall <- matrix(data=0L, nrow=13*choose(12, 3)*20, ncol=5)
pairWeight <- rep(c(12, 12, 12, 12, 12, 24, 24, 24, 24, 24, 24, 
                    12, 12, 12, 24, 24, 24, 24, 24, 24), 
                  times=13*choose(12, 3)
                  )
curIdx <- 1

for (intCtr in 1:13) {
    intAvail <- (1:13)[-intCtr]
    for (intCtr2 in intAvail[-c(11, 12)]) {
        nextAvail <- (intCtr2+1):13
        nextAvail <- nextAvail[!(nextAvail %in% c(intCtr))]
        for (intCtr3 in nextAvail[-length(nextAvail)]) {
            lastAvail <- (intCtr3+1):13
            lastAvail <- lastAvail[!(lastAvail %in% c(intCtr))]
            for (intCtr4 in lastAvail) {
                # Weight 12 (2): Singletons all same suit, once matching to a pair suit, and once not
                pairSmall[curIdx, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3, intCtr4))
                pairSmall[curIdx+1, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3+26, intCtr4+26))
            
                # Weight 12 (3): Singletons are suited 2-1, all matching to the pairs - 112, 121, 211
                pairSmall[curIdx+2, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3, intCtr4+13))
                pairSmall[curIdx+3, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+13, intCtr4))
                pairSmall[curIdx+4, ] <- sort(c(intCtr, intCtr+13, intCtr2+13, intCtr3, intCtr4))
                
                # Weight 24 (3): Singletons are suited 2-1, two matching to the pairs - 113, 131, 311
                pairSmall[curIdx+5, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3, intCtr4+26))
                pairSmall[curIdx+6, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+26, intCtr4))
                pairSmall[curIdx+7, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3, intCtr4))
                
                # Weight 24 (3): Singletons are suited 2-1, one matching to the pairs - 133, 313, 331 
                pairSmall[curIdx+8, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+26, intCtr4+26))
                pairSmall[curIdx+9, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3, intCtr4+26))
                pairSmall[curIdx+10, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3+26, intCtr4))
                
                # Weight 12 (3): Singletons are suited 2-1, none matching to the pairs - 344, 434, 443
                pairSmall[curIdx+11, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3+39, intCtr4+39))
                pairSmall[curIdx+12, ] <- sort(c(intCtr, intCtr+13, intCtr2+39, intCtr3+26, intCtr4+39))
                pairSmall[curIdx+13, ] <- sort(c(intCtr, intCtr+13, intCtr2+39, intCtr3+39, intCtr4+26))
                
                # Weight 24 (3): Singletons are suited 1-1-1, two matching to the pairs - 123, 132, 312
                pairSmall[curIdx+14, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+13, intCtr4+26))
                pairSmall[curIdx+15, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+26, intCtr4+13))
                pairSmall[curIdx+16, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3, intCtr4+13))
                
                # Weight 24 (3): Singletons are suited 1-1-1, one matching to the pairs - 134, 314, 341
                pairSmall[curIdx+17, ] <- sort(c(intCtr, intCtr+13, intCtr2, intCtr3+26, intCtr4+39))
                pairSmall[curIdx+18, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3, intCtr4+39))
                pairSmall[curIdx+19, ] <- sort(c(intCtr, intCtr+13, intCtr2+26, intCtr3+39, intCtr4))

                # Increment the index by 20
                curIdx <- curIdx + 20
            }
        }
    }
}


# No Pair becomes even more complicated
# The entire game is in the suits for the singletons
# Weight 4 (1): Singletons all same suit - 11111
# Weight 12 (5): Singletons are suited 4-1 - 11112, 11121, 11211, 12111, 21111
# Weight 12 (10): Singletons are suited 3-2 - 11122, 11212, 11221, 12112, 12121, 
#                                             12211, 21112, 21121, 21211, 22111
# Weight 24 (10): Singletons are suited 3-1-1 - 11123, 11213, 11231, 12113, 12131,
#                                               12311, 21113, 21131, 21311, 23111
# Weight 24 (15): Singletons are suited 2-2-1 - 11223, 12123, 12213, 11232, 12132, 
#                                               12231, 11322, 12312, 12321, 13122, 
#                                               13212, 13221, 31122, 31212, 31221
# Weight 24 (10): Singletons are suited 2-1-1-1 - 11234, 12134, 12314, 12341, 21134, 
#                                                 21314, 21341, 23114, 23141, 23411
noneSmall <- matrix(data=0L, nrow=choose(13, 5)*51, ncol=5)
noneWeight <- rep(c(4, 12, 12, 12, 12, 12, 
                    12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 
                    24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 
                    24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 24, 
                    24, 24, 24, 24, 24, 24, 24, 24, 24, 24
                    ), times=choose(13, 5)
                  )

mtxAdd <- matrix(data=c(0, 0, 0, 0, 0, 
                        0, 0, 0, 0, 1,
                        0, 0, 0, 1, 0, 
                        0, 0, 1, 0, 0, 
                        0, 1, 0, 0, 0, 
                        1, 0, 0, 0, 0, 
                        0, 0, 0, 1, 1,
                        0, 0, 1, 0, 1,
                        0, 1, 0, 0, 1,
                        1, 0, 0, 0, 1,
                        0, 0, 1, 1, 0,
                        0, 1, 0, 1, 0,
                        1, 0, 0, 1, 0,
                        0, 1, 1, 0, 0,
                        1, 0, 1, 0, 0,
                        1, 1, 0, 0, 0,
                        0, 0, 0, 1, 2,
                        0, 0, 1, 0, 2,
                        0, 1, 0, 0, 2,
                        1, 0, 0, 0, 2,
                        0, 0, 1, 2, 0,
                        0, 1, 0, 2, 0,
                        1, 0, 0, 2, 0,
                        0, 1, 2, 0, 0,
                        1, 0, 2, 0, 0,
                        1, 2, 0, 0, 0,
                        0, 0, 1, 1, 2,
                        0, 1, 0, 1, 2,
                        1, 0, 0, 1, 2,
                        0, 0, 1, 2, 1,
                        0, 1, 0, 2, 1,
                        1, 0, 0, 2, 1,
                        0, 0, 2, 1, 1,
                        0, 1, 2, 0, 1,
                        1, 0, 2, 0, 1,
                        0, 2, 0, 1, 1,
                        0, 2, 1, 0, 1,
                        1, 2, 0, 0, 1,
                        2, 0, 0, 1, 1,
                        2, 0, 1, 0, 1,
                        2, 1, 0, 0, 1,
                        0, 0, 1, 2, 3,
                        0, 1, 0, 2, 3,
                        0, 1, 2, 0, 3,
                        0, 1, 2, 3, 0,
                        1, 0, 0, 2, 3,
                        1, 0, 2, 0, 3,
                        1, 0, 2, 3, 0,
                        1, 2, 0, 0, 3,
                        1, 2, 0, 3, 0,
                        1, 2, 3, 0, 0
                        ) * 13, ncol=5, byrow=TRUE)

curIdx <- 1

for (intCtr in 1:9) {
    for (intCtr2 in (intCtr+1):10) {
        for (intCtr3 in (intCtr2+1):11) {
            for (intCtr4 in (intCtr3+1):12) {
                for (intCtr5 in (intCtr4+1):13) {
                    vecNone <- c(intCtr, intCtr2, intCtr3, intCtr4, intCtr5)
                    mtxNone <- matrix(data=rep(vecNone, times=51), ncol=5, byrow=TRUE)
                    # IMPORTANT - future classification relies on low-high sorting in each row
                    noneSmall[curIdx:(curIdx+50), ] <- 
                        t(apply(mtxNone + mtxAdd, 1, FUN=sort))
                    curIdx <- curIdx + 51
                }
            }
        }
    }
}


proc.time() - startTime
##    user  system elapsed 
##    4.44    0.03    4.49

Further, the hands and weights are integrated to a single hand matrix and a single weighting vector:

startTime <- proc.time()


cardSmall <- rbind(quadSmall, fhSmall, tripSmall, twoSmall, pairSmall, noneSmall)
cardWeight <- c(quadWeight, fhWeight, tripWeight, twoWeight, pairWeight, noneWeight)

str(cardSmall)
##  num [1:134459, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
str(cardWeight)
##  num [1:134459] 4 4 4 4 4 4 4 4 4 4 ...
# Confirm that there are sill 52c5 hands after weighting
all.equal(sum(cardWeight), choose(52, 5))
## [1] TRUE
# Confirm that dimensions of hands and weight match up
all.equal(nrow(cardSmall), length(cardWeight))
## [1] TRUE
all.equal(ncol(cardSmall), 5)
## [1] TRUE
# Report the degree of space savings due to the weighting
summary(cardWeight)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    4.00   12.00   24.00   19.33   24.00   24.00
# Assign the index for each cardSmall
cardIndex <- idxCard5(cardSmall[, 1], cardSmall[, 2], cardSmall[, 3], 
                      cardSmall[, 4], cardSmall[, 5]
                      )
str(cardIndex)
##  int [1:134459] 10852 29276 46572 62787 77967 92157 105401 117742 129222 139882 ...
summary(cardIndex)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       1  286100  602500  704600 1085000 2008000
all.equal(cardIndex, unique(cardIndex))
## [1] TRUE
proc.time() - startTime
##    user  system elapsed 
##    0.31    0.02    0.32

The weighting allows for ~19x reduction in duplication which speeds processing time by roughly ~19x when using “no replacement” for drawing hands. This is a strong improvement in efficiency.

Scoring (apply pay table)

A function is created to convert hand types to scores:

makeScores <- function(inType, type2Score, idx) {
    aScores <- type2Score$val[match(inType, idx)]
    
    print(summary(aScores))
    cat("\n")
    data.frame(aScores=aScores) %>% group_by(aScores) %>% summarize(ct=n()) %>% print()
    cat("\n")
    
    aScores
}

Next, a function is written to calculate each of the following, assuming that you can get back the original card(s) on the re-draw:

  • Keep 4
  • Keep 3
  • Keep 2
  • Keep 1

There is no need to calculate Keep 5 (it is already aScores) or Keep 0 (it defaults to mean(aScores) everywhere):

findEV_YesRedraw <- function(useIdx, mtxIndices, aScores) {
    # Assuming re-draw of thrown cards
    tmpScores <- data.frame(idx=as.vector(mtxIndices[, useIdx]), 
                            val=rep(aScores, times=length(useIdx))
                            )
    
    # This is what will be returned - mean by Index
    tmpScores %>% group_by(idx) %>% summarize(ev=mean(val))
}


calcEV_YesRedraw <- function(mtxIndices, aScores) {

    tmpEVkeep4 <- findEV_YesRedraw(useIdx=2:6, mtxIndices=mtxIndices, aScores=aScores)
    tmpEVkeep3 <- findEV_YesRedraw(useIdx=7:16, mtxIndices=mtxIndices, aScores=aScores)
    tmpEVkeep2 <- findEV_YesRedraw(useIdx=17:26, mtxIndices=mtxIndices, aScores=aScores)
    tmpEVkeep1 <- findEV_YesRedraw(useIdx=27:31, mtxIndices=mtxIndices, aScores=aScores)

    print(summary(tmpEVkeep4$ev)); cat("\n")
    print(summary(tmpEVkeep3$ev)); cat("\n")
    print(summary(tmpEVkeep2$ev)); cat("\n")
    print(summary(tmpEVkeep1$ev)); cat("\n\n")

    print(sum(tmpEVkeep4$idx != 1:choose(52,4)))
    print(sum(tmpEVkeep3$idx != 1:choose(52,3)))
    print(sum(tmpEVkeep2$idx != 1:choose(52,2)))
    print(sum(tmpEVkeep1$idx != 1:choose(52,1)))

    list(tmpEVkeep4=tmpEVkeep4, tmpEVkeep3=tmpEVkeep3, 
         tmpEVkeep2=tmpEVkeep2, tmpEVkeep1=tmpEVkeep1
         )
}

The summary statistics and control totals are “as expected”, and the process takes ~8 seconds. This could be reduced to ~0.5 seconds by using a weighting that avoids redundancy. However, further effort is needed to make sure that 1) discards are never returned, and 2) optimal holds for each starting hand can be calculated.

Analysis (simulate pay table)

Next, all of the holds are run assuming you cannot re-draw discards, using the smaller database. The key elements are 1) cardSmall (actual hands), 2) cardWeight (weightings for cardSmall), and 3) cardIndex (the mapping of each hand in cardSmall to the corresponding index of aScores:

makeNoReplace <- function(aScores, cardIndex, keyList, mtxIndices) {
    
    evSmallNoReplace <- matrix(data=0.0, nrow=length(cardIndex), ncol=32)
    
    tmpEVkeep4 <- keyList$tmpEVkeep4
    tmpEVkeep3 <- keyList$tmpEVkeep3
    tmpEVkeep2 <- keyList$tmpEVkeep2
    tmpEVkeep1 <- keyList$tmpEVkeep1
    
    # Keep 5
    evSmallNoReplace[, 1] <- aScores[cardIndex]

    # Keep 4 (intCtr: 2 is 1234, 3 is 1235, 4 is 1245, 5 is 1345, 6 is 2345)
    for (intCtr in 2:6) {
        evSmallNoReplace[, intCtr] <- (48 * tmpEVkeep4$ev[mtxIndices[cardIndex, intCtr]] - 
                                           evSmallNoReplace[, 1]) / 47
    }

    # Keep 3 (intCtr: 7 is 123, 8 is 124, 9 is 125, 10 is 134, 11 is 135)
    # Keep 3 (intCtr: 12 is 145, 13 is 234, 14 is 235, 15 is 245, 16 is 345)
    # Take the EV of the 3 cards assuming stand-alone
    # Subtract the EV of each of the 4 cards (3 + 1 discard) assuming stand-alone
    # Add back the EV of the 5 cards assuming stand-alone
    mapKeep3 <- data.frame(idx=7:16, 
                           keep1=c(2, 2, 3, 2, 3, 4, 2, 3, 4, 5), 
                           keep2=c(3, 4, 4, 5, 5, 5, 6, 6, 6, 6)
                           )
    for (intCtr in 7:16) {
        c1 <- mapKeep3$keep1[mapKeep3$idx == intCtr]
        c2 <- mapKeep3$keep2[mapKeep3$idx == intCtr]
        evSmallNoReplace[, intCtr] <- (choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, intCtr]] - 
                                      48 * tmpEVkeep4$ev[mtxIndices[cardIndex, c1]] -
                                      48 * tmpEVkeep4$ev[mtxIndices[cardIndex, c2]] + 
                                      evSmallNoReplace[, 1]
                                  ) / choose(47, 2)
    }

    # Keep 2 (intCtr: 17 is 12, 18 is 13, 19 is 14, 20 is 15, 21 is 23)
    # Keep 2 (intCtr: 22 is 24, 23 is 25, 24 is 34, 25 is 35, 26 is 45)
    # Take the EV of the 2 cards assuming stand-alone
    # Subtract the EV of each of the 3 cards (2 + 1 discard) assuming stand-alone
    # add back the EV of each of the 4 cards (2 + 2 discard) assuming stand-alone
    # Subtract the EV of the 5 cards assuming stand-alone
    mapKeep2 <- data.frame(idx=17:26, 
                           keep3_1=c(7,  7,  8,  9,  7,  8,  9, 10, 11, 12), 
                           keep3_2=c(8, 10, 10, 11, 13, 13, 14, 13, 14, 15),
                           keep3_3=c(9, 11, 12, 12, 14, 15, 15, 16, 16, 16),
                           keep4_1=c(2, 2, 2, 3, 2, 2, 3, 2, 3, 4),
                           keep4_2=c(3, 3, 4, 4, 3, 4, 4, 5, 5, 5),
                           keep4_3=c(4, 5, 5, 5, 6, 6, 6, 6, 6, 6)
                           )

    for (intCtr in 17:26) {
        c31 <- mapKeep2$keep3_1[mapKeep2$idx == intCtr]
        c32 <- mapKeep2$keep3_2[mapKeep2$idx == intCtr]
        c33 <- mapKeep2$keep3_3[mapKeep2$idx == intCtr]
    
        c41 <- mapKeep2$keep4_1[mapKeep2$idx == intCtr]
        c42 <- mapKeep2$keep4_2[mapKeep2$idx == intCtr]
        c43 <- mapKeep2$keep4_3[mapKeep2$idx == intCtr]
    
        evSmallNoReplace[, intCtr] <- (choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, intCtr]] - 
                                      choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c31]] -
                                      choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c32]] -
                                      choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c33]] +
                                      choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c41]] +
                                      choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c42]] +
                                      choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c43]] -
                                      evSmallNoReplace[, 1]
                                    ) / choose(47, 3)
    }

    # Keep 1 (intCtr: 27 is 1, 28 is 2, 29 is 3, 30 is 4, 31 is 5)
    # Take the EV of the 1 card assuming stand-alone
    # Subtract the EV of the 2 cards (1 + 1 discard) assuming stand-alone
    # Add back the EV of each of the 3 cards (1 + 2 discard) assuming stand-alone
    # Subtract the EV of each of the 4 cards (1 + 3 discard) assuming stand-alone
    # Add back the EV of the 5 cards assuming stand-alone
    mapKeep1 <- data.frame(idx=27:31,
                           keep2_1=c(17, 17, 18, 19, 20),
                           keep2_2=c(18, 21, 21, 22, 23),
                           keep2_3=c(19, 22, 24, 24, 25),
                           keep2_4=c(20, 23, 25, 26, 26),
                           keep3_1=c(7,   7,  7,  8,  9), 
                           keep3_2=c(8,   8, 10, 10, 11),
                           keep3_3=c(9,   9, 11, 12, 12),
                           keep3_4=c(10, 13, 13, 13, 14),
                           keep3_5=c(11, 14, 14, 15, 15),
                           keep3_6=c(12, 15, 16, 16, 16),
                           keep4_1=c(2, 2, 2, 2, 3),
                           keep4_2=c(3, 3, 3, 4, 4),
                           keep4_3=c(4, 4, 5, 5, 5),
                           keep4_4=c(5, 6, 6, 6, 6)
                           )

    for (intCtr in 27:31) {
        c21 <- mapKeep1$keep2_1[mapKeep1$idx == intCtr]
        c22 <- mapKeep1$keep2_2[mapKeep1$idx == intCtr]
        c23 <- mapKeep1$keep2_3[mapKeep1$idx == intCtr]
        c24 <- mapKeep1$keep2_4[mapKeep1$idx == intCtr]
    
        c31 <- mapKeep1$keep3_1[mapKeep1$idx == intCtr]
        c32 <- mapKeep1$keep3_2[mapKeep1$idx == intCtr]
        c33 <- mapKeep1$keep3_3[mapKeep1$idx == intCtr]
        c34 <- mapKeep1$keep3_4[mapKeep1$idx == intCtr]
        c35 <- mapKeep1$keep3_5[mapKeep1$idx == intCtr]
        c36 <- mapKeep1$keep3_6[mapKeep1$idx == intCtr]
    
        c41 <- mapKeep1$keep4_1[mapKeep1$idx == intCtr]
        c42 <- mapKeep1$keep4_2[mapKeep1$idx == intCtr]
        c43 <- mapKeep1$keep4_3[mapKeep1$idx == intCtr]
        c44 <- mapKeep1$keep4_4[mapKeep1$idx == intCtr]
    
        evSmallNoReplace[, intCtr] <- (choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, intCtr]] - 
                                      choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, c21]] -
                                      choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, c22]] - 
                                      choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, c23]] - 
                                      choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, c24]] + 
                                      choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c31]] +
                                      choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c32]] +
                                      choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c33]] +
                                      choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c34]] +
                                      choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c35]] +
                                      choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, c36]] -
                                      choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c41]] -
                                      choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c42]] -
                                      choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c43]] -
                                      choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, c44]] +
                                      evSmallNoReplace[, 1]
                                ) / choose(47, 4)
    }

    # Keep 0 (column 32)
    # Take the EV of the 0 card assuming stand-alone
    # Subtract the EV of each 1 card (0 + 1 discard) assuming stand-alone
    # Add back the EV of each of the 2 cards (0 + 2 discard) assuming stand-alone
    # Subtract the EV of each of the 3 cards (0 + 3 discard) assuming stand-alone
    # Add back the EV of each of the 4 cards (0 + 4 discard) assuming stand-alone
    # Subtract the EV of the 5 cards assuming stand-alone

    evSmallNoReplace[, 32] <- (choose(52, 5) * mean(aScores) - 
                              choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 31]] -
                              choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 30]] - 
                              choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 29]] - 
                              choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 28]] - 
                              choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 27]] +
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 26]] +
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 25]] + 
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 24]] + 
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 23]] + 
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 22]] + 
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 21]] + 
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 20]] + 
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 19]] + 
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 18]] + 
                              choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 17]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 16]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 15]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 14]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 13]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 12]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 11]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 10]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 9]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 8]] -
                              choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 7]] +
                              choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 6]] +
                              choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 5]] +
                              choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 4]] +
                              choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 3]] +
                              choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 2]] -
                              evSmallNoReplace[, 1]
                          ) / choose(47, 5)

    evSmallNoReplace
}

The optimal holds and aggregate EV are the assessed:

descStat <- function(tempSmallMax, cardWeight) {

    # Calculate descriptive statistics
    print(summary(rep(tempSmallMax[1, ], times=cardWeight))); cat("\n")
    print(1 + mean(rep(tempSmallMax[1, ], times=cardWeight))); cat("\n")

    hist(rep(tempSmallMax[2, ], times=cardWeight), breaks=0:33, main="Index for Cards Held", 
         xlab="1 (hold 5) --- 2-6 (hold 4: 1234, 1235, 1245, 1345, 2345) -- etc. -- 32 (hold 0)",
        col=c( rep("blue", 1), rep("lightblue", 5), rep("orange", 10),
                rep("lightgreen", 10), rep("red", 5), rep("black", 1) 
            ) 
        )

    newSmallCutIdx <- cut(tempSmallMax[2, ], 
                     breaks=c(0.5, 1.5, 6.5, 16.5, 26.5, 31.5, 32.5)
                     )

    data.frame(newType=rep(newSmallCutIdx, times=cardWeight)) %>% 
        group_by(newType) %>% summarize(ct=n())

}

The control totals and expected values were as expected, and the program runs in ~10 seconds!

Next, the scoring and analysis are converted to functions, with the simulation re-run:

# Simulate a specific pay-table
simGame <- function(aT=aType, h2S=hnd2Score, gameI=gameIndex, mtxI=mtxIndices, 
                    cardI=cardIndex, cardW=cardWeight, startT=startTime, 
                    grTitle="Simulation Results", allOut=FALSE
                    ) {
    
    # Convert to Scores
    aScores <- makeScores(inType=aT, type2Score=h2S, idx=gameI)

    # Get the EV assuming re-draws are allowed
    keyList <- calcEV_YesRedraw(mtxIndices=mtxI, aScores=aScores)

    # Make the EV grid for "no replacement"
    evSmallNoReplace <- makeNoReplace(aScores=aScores, cardIndex=cardI, 
                                      keyList=keyList, mtxIndices=mtxI
                                      )

    # Find the best holds
    tempSmallMax <- apply(evSmallNoReplace, 1, FUN=function(x) { c(max(x), which.max(x)) } )
    descStat(tempSmallMax=tempSmallMax, cardWeight=cardW)
    
    if (allOut) {
        return(list(tempSmallMax=tempSmallMax, 
                    evSmallNoReplace=evSmallNoReplace, 
                    aScores=aScores, 
                    keyList=keyList
                    )
               )
    } else {
        return(list(tempSmallMax=tempSmallMax, 
                    evSmallNoReplace=evSmallNoReplace
                    )
               )
    }
}


# Use one pay-table on a different game
simPayTable <- function(useEV, useHold, useWeights) {
    
    # Confirm dimensions
    if (length(useHold) != nrow(useEV) | length(useHold) != length(useWeights)) {
        print(str(useEV))
        print(str(useHold))
        print(str(useWeights))
        stop("Error: Inconsistent dimensions for simulation; check and re-try")
    }
    
    # useHold (vector 134,459) determines which column to use 
    # for each respective row of useEV (matrix 134,459 x 32)
    newEV <- useEV[ cbind(1:nrow(useEV), useHold) ]
    print(summary(rep(newEV, times=useWeights)))
    
    return(newEV)
}

The simulations take ~10 seconds each, and the results are cached for quicker run times:

startTime <- proc.time()


# Run the game for JB 96
gameIndex <- 0:25
jb96hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                 799, 49,  8,  5,  3, 
                                                   2,  1,  0,  0,  0, 
                                                   0, -1, -1, 24, 24, 
                                                  24, 24, 24, 24, 24, 
                                                  24, 24, 24, 24, 24
                                            )
                        )

jb96List <- simGame(h2S=jb96hnd2Score)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6631  -1.0000 799.0000 
## 
## # A tibble: 10 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  337920
## 3        1  123552
## 4        2   54912
## 5        3   10200
## 6        5    5108
## 7        8    3744
## 8       24     624
## 9       49      36
## 10     799       4
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.0000 -0.9375 -0.8750 -0.6631 -0.6250 24.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9107 -0.8138 -0.8138 -0.6631 -0.6624  3.2650 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8122 -0.7731 -0.6898 -0.6631 -0.6506  0.5143 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7177 -0.7049 -0.7049 -0.6631 -0.5668 -0.5582 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6426  -0.5175  -0.1763  -0.0046   0.1489 799.0000 
## 
## [1] 0.995439

proc.time() - startTime
##    user  system elapsed 
##    9.06    0.94   10.28
# Run the game for JB 85
gameIndex <- 0:25
jb85hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                 799, 49,  7,  4,  3, 
                                                   2,  1,  0,  0,  0, 
                                                   0, -1, -1, 24, 24, 
                                                  24, 24, 24, 24, 24, 
                                                  24, 24, 24, 24, 24
                                            )
                        )

jb85List <- simGame(h2S=jb85hnd2Score)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6665  -1.0000 799.0000 
## 
## # A tibble: 10 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  337920
## 3        1  123552
## 4        2   54912
## 5        3   10200
## 6        4    5108
## 7        7    3744
## 8       24     624
## 9       49      36
## 10     799       4
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.0000 -0.9375 -0.8750 -0.6665 -0.6250 24.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9107 -0.8138 -0.8138 -0.6665 -0.6624  3.2040 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8132 -0.7740 -0.6907 -0.6665 -0.6515  0.5045 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7211 -0.7083 -0.7083 -0.6665 -0.5702 -0.5616 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6458  -0.5219  -0.1865  -0.0270  -0.0426 799.0000 
## 
## [1] 0.9729843

proc.time() - startTime
##    user  system elapsed 
##   16.38    1.69   18.63
# Nothing
# RF, SF, FH, FL, ST
# Trips, 2P, AA, KK, QQ
# JJ, TT, 22-99, AAAA 2-4, AAAA J-K
# AAAA 5-T, 2222/3333/4444 A, 2222/3333/4444 2-4, 2222/3333/4444 J-K, 2222/3333/4444 5-T
# JJJJ/QQQQ/KKKK A, JJJJ/QQQQ/KKKK 2-4, JJJJ/QQQQ/KKKK J-K, JJJJ/QQQQ/KKKK 5-T, 5555-TTTT

# Run the game for BP 85
gameIndex <- 0:25
bp85hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                 799, 49,  7,  4,  3, 
                                                   2,  1,  0,  0,  0, 
                                                   0, -1, -1, 79, 79, 
                                                  79, 39, 39, 39, 39, 
                                                  24, 24, 24, 24, 24
                                            )
                        )

bp85List <- simGame(h2S=bp85hnd2Score)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6647  -1.0000 799.0000 
## 
## # A tibble: 12 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  337920
## 3        1  123552
## 4        2   54912
## 5        3   10200
## 6        4    5108
## 7        7    3744
## 8       24     432
## 9       39     144
## 10      49      36
## 11      79      48
## 12     799       4
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.0000 -0.9375 -0.8750 -0.6647 -0.6250 79.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9107 -0.8138 -0.8138 -0.6647 -0.6624  5.4490 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8132 -0.7732 -0.6907 -0.6647 -0.6515  0.6392 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7178 -0.7079 -0.7079 -0.6647 -0.5698 -0.5594 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6434  -0.5183  -0.1865  -0.0083  -0.0426 799.0000 
## 
## [1] 0.9916597

proc.time() - startTime
##    user  system elapsed 
##   23.88    2.37   26.88
# Run the game for DDB 96
gameIndex <- 0:25
ddb96hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                  799, 49,  8,  5,  3, 
                                                    2,  0,  0,  0,  0, 
                                                    0, -1, -1, 399, 159, 
                                                  159, 159, 159, 79, 79, 
                                                   49, 49, 49, 49, 49
                                             )
                         )

ddb96List <- simGame(h2S=ddb96hnd2Score)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6988  -1.0000 799.0000 
## 
## # A tibble: 11 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  461472
## 3        2   54912
## 4        3   10200
## 5        5    5108
## 6        8    3744
## 7       49     468
## 8       79     108
## 9      159      72
## 10     399      12
## 11     799       4
## 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -0.9375  -0.8750  -0.6988  -0.7500 219.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9337 -0.8367 -0.8367 -0.6988 -0.6854 11.2200 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8501 -0.8094 -0.7277 -0.6988 -0.6885  0.8302 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7473 -0.7456 -0.7430 -0.6988 -0.6075 -0.5743 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6770  -0.5414  -0.2668  -0.0102   0.1489 799.0000 
## 
## [1] 0.9898078

proc.time() - startTime
##    user  system elapsed 
##   30.84    3.14   34.77
# Run the game for TDB 97
gameIndex <- 0:25
tdb97hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                  799,  49,   8,   6,   3, 
                                                    1,   0,   0,   0,   0, 
                                                    0,  -1,  -1, 799, 159, 
                                                  159, 399, 399,  79,  79, 
                                                   49,  49,  49,  49,  49
                                             )
                         )

tdb97List <- simGame(h2S=tdb97hnd2Score)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.7128  -1.0000 799.0000 
## 
## # A tibble: 11 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  461472
## 3        1   54912
## 4        3   10200
## 5        6    5108
## 6        8    3744
## 7       49     468
## 8       79     108
## 9      159      36
## 10     399      36
## 11     799      16
## 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -0.9375  -0.8750  -0.7128  -0.7917 319.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9413 -0.8444 -0.8444 -0.7128 -0.6930 14.4100 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8658 -0.8136 -0.7434 -0.7128 -0.6844  0.9673 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7648 -0.7648 -0.7514 -0.7128 -0.6266 -0.5714 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6933  -0.5364  -0.3811  -0.0042   0.3317 799.0000 
## 
## [1] 0.9957781

proc.time() - startTime
##    user  system elapsed 
##   37.81    3.85   42.51
# Run the game for TDB 96
gameIndex <- 0:25
tdb96hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                  799,  49,   8,   5,   3, 
                                                    1,   0,   0,   0,   0, 
                                                    0,  -1,  -1, 799, 159, 
                                                  159, 399, 399,  79,  79, 
                                                   49,  49,  49,  49,  49
                                             )
                         )

tdb96List <- simGame(h2S=tdb96hnd2Score)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.7147  -1.0000 799.0000 
## 
## # A tibble: 11 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  461472
## 3        1   54912
## 4        3   10200
## 5        5    5108
## 6        8    3744
## 7       49     468
## 8       79     108
## 9      159      36
## 10     399      36
## 11     799      16
## 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -0.9375  -0.8750  -0.7147  -0.7917 319.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9413 -0.8444 -0.8444 -0.7147 -0.6930 14.4100 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8658 -0.8138 -0.7434 -0.7147 -0.6929  0.9673 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7667 -0.7667 -0.7534 -0.7147 -0.6286 -0.5734 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6952  -0.5391  -0.3811  -0.0185   0.1489 799.0000 
## 
## [1] 0.98154

proc.time() - startTime
##    user  system elapsed 
##   45.03    4.67   50.70
# Run the game for BPD 96
gameIndex <- 0:25
bpd96hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                  799,  49,   8,   5,   3, 
                                                    2,   0,   0,   0,   0, 
                                                    0,  -1,  -1,  79,  79, 
                                                   79,  79,  79,  79,  79, 
                                                   79,  79,  79,  79,  79
                                             )
                         )

bpd96List <- simGame(h2S=bpd96hnd2Score)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6975  -1.0000 799.0000 
## 
## # A tibble: 9 × 2
##   aScores      ct
##     <dbl>   <int>
## 1      -1 2062860
## 2       0  461472
## 3       2   54912
## 4       3   10200
## 5       5    5108
## 6       8    3744
## 7      49      36
## 8      79     624
## 9     799       4
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.0000 -0.9375 -0.8750 -0.6975 -0.7500 79.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9337 -0.8367 -0.8367 -0.6975 -0.6854  5.5100 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8470 -0.8079 -0.7246 -0.6975 -0.6854  0.4873 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7520 -0.7392 -0.7392 -0.6975 -0.6011 -0.5926 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6770  -0.5528  -0.1835  -0.0036   0.1489 799.0000 
## 
## [1] 0.9964171

proc.time() - startTime
##    user  system elapsed 
##   52.59    5.43   59.25

The various games are then assessed, including implications on EV when using strategy A on game B:

startTime <- proc.time()


# Find the EV for using the JB 96 strategy on the JB 85 game
sum(jb85List$tempSmallMax[2,] != jb96List$tempSmallMax[2,])
## [1] 597
sum((jb85List$tempSmallMax[2,] != jb96List$tempSmallMax[2,]) * cardWeight)
## [1] 10956
jb85EV_jb96Holds <- simPayTable(useEV=jb85List$evSmallNoReplace, 
                                useHold=jb96List$tempSmallMax[2, ], 
                                useWeights=cardWeight
                                )
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6458  -0.5219  -0.1865  -0.0271  -0.0426 799.0000
1 + mean(rep(jb85EV_jb96Holds, times=cardWeight))
## [1] 0.9729123
mean(rep(jb85EV_jb96Holds - jb85List$tempSmallMax[1, ], times=cardWeight))
## [1] -7.201211e-05
proc.time() - startTime
##    user  system elapsed 
##    0.71    0.07    0.78
# Find the EV for using the JB 96 strategy on the BP 85 game
sum(bp85List$tempSmallMax[2,] != jb96List$tempSmallMax[2,])
## [1] 721
sum((bp85List$tempSmallMax[2,] != jb96List$tempSmallMax[2,]) * cardWeight)
## [1] 13728
bp85EV_jb96Holds <- simPayTable(useEV=bp85List$evSmallNoReplace, 
                                useHold=jb96List$tempSmallMax[2, ], 
                                useWeights=cardWeight
                                )
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6434  -0.5184  -0.1865  -0.0084  -0.0426 799.0000
1 + mean(rep(bp85EV_jb96Holds, times=cardWeight))
## [1] 0.9915825
mean(rep(bp85EV_jb96Holds - bp85List$tempSmallMax[1, ], times=cardWeight))
## [1] -7.724575e-05
proc.time() - startTime
##    user  system elapsed 
##    1.02    0.16    1.22
# Find the EV for using the JB 96 strategy on the DDB 96 game
sum(ddb96List$tempSmallMax[2,] != jb96List$tempSmallMax[2,])
## [1] 13077
sum((ddb96List$tempSmallMax[2,] != jb96List$tempSmallMax[2,]) * cardWeight)
## [1] 281580
ddb96EV_jb96Holds <- simPayTable(useEV=ddb96List$evSmallNoReplace, 
                                useHold=jb96List$tempSmallMax[2, ], 
                                useWeights=cardWeight
                                )
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6770  -0.5507  -0.2668  -0.0156   0.1489 799.0000
1 + mean(rep(ddb96EV_jb96Holds, times=cardWeight))
## [1] 0.9844227
d_jb96_ddb96 <- ddb96EV_jb96Holds - ddb96List$tempSmallMax[1, ]
mean(rep(d_jb96_ddb96, times=cardWeight))
## [1] -0.005385149
data.frame(dEV=rep(d_jb96_ddb96, times=cardWeight)) %>% 
    mutate(rndDelta=round(dEV, 2)) %>% 
    group_by(rndDelta) %>%
    summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight))
## # A tibble: 14 × 3
##    rndDelta      ct       evLoss
##       <dbl>   <int>        <dbl>
## 1    -61.28      36 -0.084883184
## 2    -20.43     108 -0.084897036
## 3     -3.72     216 -0.030916982
## 4     -3.27      72 -0.009059008
## 5     -0.25   10368 -0.099732201
## 6     -0.24    3888 -0.035903592
## 7     -0.22    3888 -0.032911626
## 8     -0.21     864 -0.006981254
## 9     -0.08     696 -0.002142395
## 10    -0.04     756 -0.001163542
## 11    -0.03   12492 -0.014419614
## 12    -0.02  113508 -0.087348786
## 13    -0.01  121344 -0.046689445
## 14     0.00 2330724  0.000000000
proc.time() - startTime
##    user  system elapsed 
##    1.70    0.21    1.95
# Find the EV for using the DDB 96 strategy on the TDB 97 game
sum(tdb97List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,])
## [1] 15421
sum((tdb97List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,]) * cardWeight)
## [1] 273012
tdb97EV_ddb96Holds <- simPayTable(useEV=tdb97List$evSmallNoReplace, 
                                  useHold=ddb96List$tempSmallMax[2, ], 
                                  useWeights=cardWeight
                                  )
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6933  -0.5364  -0.3811  -0.0151   0.3317 799.0000
1 + mean(rep(tdb97EV_ddb96Holds, times=cardWeight))
## [1] 0.9849045
d_ddb96_tdb97 <- tdb97EV_ddb96Holds - tdb97List$tempSmallMax[1, ]
mean(rep(d_ddb96_tdb97, times=cardWeight))
## [1] -0.0108736
data.frame(dEV=rep(d_ddb96_tdb97, times=cardWeight)) %>% 
    mutate(rndDelta=round(dEV, 2)) %>% 
    group_by(rndDelta) %>%
    summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight)) %>%
    print.data.frame()
##    rndDelta      ct        evLoss
## 1     -4.35     192 -0.0321359313
## 2     -4.20      72 -0.0116354234
## 3     -3.76    1728 -0.2499953828
## 4     -2.21     576 -0.0489795918
## 5     -1.91    5184 -0.3809770062
## 6     -1.77     216 -0.0147104996
## 7     -0.31     648 -0.0077292455
## 8     -0.18     828 -0.0057346015
## 9     -0.16     576 -0.0035460338
## 10    -0.15    2376 -0.0137131776
## 11    -0.14     120 -0.0006464124
## 12    -0.13     180 -0.0009003601
## 13    -0.12    4572 -0.0211099825
## 14    -0.11     144 -0.0006094746
## 15    -0.10     492 -0.0018930649
## 16    -0.09    1356 -0.0046957244
## 17    -0.08    1848 -0.0056884292
## 18    -0.07    1176 -0.0031674208
## 19    -0.06    7128 -0.0164558131
## 20    -0.05   49392 -0.0950226244
## 21    -0.04   41652 -0.0641056423
## 22    -0.03   38208 -0.0441037954
## 23    -0.02   62880 -0.0483885862
## 24    -0.01   32556 -0.0125265491
## 25     0.00 2344860  0.0000000000
proc.time() - startTime
##    user  system elapsed 
##    2.37    0.30    2.71
# Find the EV for using the DDB 96 strategy on the TDB 96 game
sum(tdb96List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,])
## [1] 7376
sum((tdb96List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,]) * cardWeight)
## [1] 134820
tdb96EV_ddb96Holds <- simPayTable(useEV=tdb96List$evSmallNoReplace, 
                                  useHold=ddb96List$tempSmallMax[2, ], 
                                  useWeights=cardWeight
                                  )
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6952  -0.5391  -0.3811  -0.0264   0.1489 799.0000
1 + mean(rep(tdb96EV_ddb96Holds, times=cardWeight))
## [1] 0.973546
d_ddb96_tdb96 <- tdb96EV_ddb96Holds - tdb96List$tempSmallMax[1, ]
mean(rep(d_ddb96_tdb96, times=cardWeight))
## [1] -0.007994002
data.frame(dEV=rep(d_ddb96_tdb96, times=cardWeight)) %>% 
    mutate(rndDelta=round(dEV, 2)) %>% 
    group_by(rndDelta) %>%
    summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight)) %>%
    print.data.frame()
##    rndDelta      ct        evLoss
## 1     -4.35     192 -3.213593e-02
## 2     -4.20      72 -1.163542e-02
## 3     -3.76    1728 -2.499954e-01
## 4     -2.21     576 -4.897959e-02
## 5     -1.91    5184 -3.809770e-01
## 6     -1.77     216 -1.471050e-02
## 7     -0.31     648 -7.729246e-03
## 8     -0.11      72 -3.047373e-04
## 9     -0.10     120 -4.617232e-04
## 10    -0.09     180 -6.233263e-04
## 11    -0.08     888 -2.733401e-03
## 12    -0.07     288 -7.756949e-04
## 13    -0.06    6852 -1.581864e-02
## 14    -0.05      12 -2.308616e-05
## 15    -0.04      36 -5.540678e-05
## 16    -0.03    2736 -3.158186e-03
## 17    -0.02    4692 -3.610675e-03
## 18    -0.01   55860 -2.149321e-02
## 19     0.00 2518608  0.000000e+00
proc.time() - startTime
##    user  system elapsed 
##    2.98    0.41    3.43
# Find the EV for using the DDB 96 strategy on the JB 96 game
sum(jb96List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,])
## [1] 13077
sum((jb96List$tempSmallMax[2,] != ddb96List$tempSmallMax[2,]) * cardWeight)
## [1] 281580
jb96EV_ddb96Holds <- simPayTable(useEV=jb96List$evSmallNoReplace, 
                                 useHold=ddb96List$tempSmallMax[2, ], 
                                 useWeights=cardWeight
                                 )
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6596  -0.5204  -0.1763  -0.0149   0.1489 799.0000
1 + mean(rep(jb96EV_ddb96Holds, times=cardWeight))
## [1] 0.9851137
d_ddb96_jb96 <- jb96EV_ddb96Holds - jb96List$tempSmallMax[1, ]
mean(rep(d_ddb96_jb96, times=cardWeight))
## [1] -0.01032537
data.frame(dEV=rep(d_ddb96_jb96, times=cardWeight)) %>% 
    mutate(rndDelta=round(dEV, 2)) %>% 
    group_by(rndDelta) %>%
    summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight)) %>%
    print.data.frame()
##    rndDelta      ct        evLoss
## 1     -4.69     288 -0.0519715579
## 2     -1.06   19008 -0.7752516391
## 3     -0.08    1116 -0.0034352202
## 4     -0.07     180 -0.0004848093
## 5     -0.06     108 -0.0002493305
## 6     -0.05    1188 -0.0022855296
## 7     -0.04   10272 -0.0158094007
## 8     -0.03   36336 -0.0419429310
## 9     -0.02  161832 -0.1245359682
## 10    -0.01   50352 -0.0193739034
## 11     0.00 2318280  0.0000000000
proc.time() - startTime
##    user  system elapsed 
##    3.53    0.47    4.04
# Find the EV for using the JB 96 strategy on the BPD 96 game
sum(bpd96List$tempSmallMax[2,] != jb96List$tempSmallMax[2,])
## [1] 3036
sum((bpd96List$tempSmallMax[2,] != jb96List$tempSmallMax[2,]) * cardWeight)
## [1] 65244
bpd96EV_jb96Holds <- simPayTable(useEV=bpd96List$evSmallNoReplace, 
                                 useHold=jb96List$tempSmallMax[2, ], 
                                 useWeights=cardWeight
                                 )
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6771  -0.5536  -0.1835  -0.0039   0.1489 799.0000
1 + mean(rep(bpd96EV_jb96Holds, times=cardWeight))
## [1] 0.9961002
d_jb96_bpd96 <- bpd96EV_jb96Holds - bpd96List$tempSmallMax[1, ]
mean(rep(d_jb96_bpd96, times=cardWeight))
## [1] -0.000316954
data.frame(dEV=rep(d_jb96_bpd96, times=cardWeight)) %>% 
    mutate(rndDelta=round(dEV, 2)) %>% 
    group_by(rndDelta) %>%
    summarize(ct=n(), evLoss=100 * sum(rndDelta)/sum(cardWeight))
## # A tibble: 5 × 3
##   rndDelta      ct        evLoss
##      <dbl>   <int>         <dbl>
## 1    -0.04     108 -0.0001662203
## 2    -0.03     648 -0.0007479915
## 3    -0.02   26220 -0.0201773017
## 4    -0.01   26088 -0.0100378613
## 5     0.00 2545896  0.0000000000
proc.time() - startTime
##    user  system elapsed 
##    4.17    0.53    4.74
# Find variance for initial dealt cards in JB 96,  JB 85,  BP 85, 
#                                          DDB 96, TDB 97, TDB 96, and BPD 96
findMeanVar <- function(useList, useName, useWeight=cardWeight) {
    gameMean <- mean(rep(useList$tempSmallMax[1, ], times=useWeight))
    gameVar <- var(rep(useList$tempSmallMax[1, ], times=useWeight))
    print(paste0("Game ", useName, ":  Return: ", signif(1+gameMean, 5), 
                 " and Variance on Deal: ", signif(gameVar, 4)
                 )
          )
}

findMeanVar(useList=jb96List, useName="JB 96")
## [1] "Game JB 96:  Return: 0.99544 and Variance on Deal: 1.966"
findMeanVar(useList=jb85List, useName="JB 85")
## [1] "Game JB 85:  Return: 0.97298 and Variance on Deal: 1.903"
findMeanVar(useList=bp85List, useName="BP 85")
## [1] "Game BP 85:  Return: 0.99166 and Variance on Deal: 2.12"
findMeanVar(useList=ddb96List, useName="DDB 96")
## [1] "Game DDB 96:  Return: 0.98981 and Variance on Deal: 4.809"
findMeanVar(useList=tdb97List, useName="TDB 97")
## [1] "Game TDB 97:  Return: 0.99578 and Variance on Deal: 10.7"
findMeanVar(useList=tdb96List, useName="TDB 96")
## [1] "Game TDB 96:  Return: 0.98154 and Variance on Deal: 10.68"
findMeanVar(useList=bpd96List, useName="BPD 96")
## [1] "Game BPD 96:  Return: 0.99642 and Variance on Deal: 3.685"

The functional approach takes ~10 seconds per game and generates the correct results.

Specific to using the JB96 strategy on the DDB 96 game, errors are generated as follows:

  • AAppx (should just keep AA) - 19,008 hands, 0.18% penalty
  • AAAA with 5-K or 2222/3333/4444 with 5-K (should discard 5-K) - 144 hands, 0.17% penalty
  • A-Hx-T/L-L-L (should keep A) and inside-straight (go for it) - 234,852 hands, 0.13% penalty
  • AAA with 55/66/77/88/99/TT/JJ/QQ/KK (should just keep AAA) - 216 hands, 0.03% penalty
  • AAA with 22/33/44 (should just keep AAA) - 72 hands, 0.01% penalty
  • mix of HHTLL - 12,492 hands, 0.01% penalty
  • QJTT9 or QJT99 (should keep QJT9) - 696 hands, <0.01% penalty
  • AKQsJs (should keep AKQJ) - 756 hands, <0.01% penalty

Specific to using the DDB96 strategy on the TDB97 and TDB96 games, errors are generated as follows:

  • TDB97 - ~10% of holds should change from DDB 96, with EV declining by ~1.1% from ~99.6% to ~98.5% otherwise (roughly ~0.7% of the decline is driven by what to hold with dealt AAA/222/333/444)
  • TDB96 - ~5% of holds should change from DDB 96, with EV declining by ~0.8% from ~98.2% to ~97.4% otherwise (roughly ~0.7% of the decline is driven by what to hold with dealt AAA/222/333/444)

Specific to using the DDB 96 strategy on the JB 96 games, errors are generated of ~1.0% (reducing returns from ~99.5% to ~98.5%). Almost all of the errors are related to the AAAxx, AAPPx, and AHHxx holds.

Specific to using the JB 96 strategy on the BPD 96 games, only minimal (<0.1% EV) errors are generated.

Broadly, playing strategy for the following games incurs minimal errors:

  • JB 96, JB 95, BP 85, BPD 96 - use the JB 96 strategy which has very minimal errors throughout
  • DDB 96 - modify the JB 96 strategy to account for value of Aces and Kickers (hold AAAA vs AAAA/5-K, hold AAA vs AAApp, hold AA vs AAppx, hold A vs AK/AQ/AJ/KQ/KJ/QJ)
  • TDB 96 (and to an extent TDP 97) - use the DDB 96 strategy, adjusted to keep kickers with AAA/222/333/444 if available

Additionally, an algorithm is written to return the specific cards that are held for any given set of strategies:

findHolds <- function(idxKeep, myCards=cardSmall) {
    # 1     is keep all 5
    # 2-6   is keep 4 (1234, 1235, 1245, 1345, 2345)
    # 7-16  is keep 3 (123, 124, 125, 134, 135, 145, 234, 235, 245, 345)
    # 17-26 is keep 2 (12, 13, 14, 15, 23, 24, 25, 34, 35, 45)
    # 27-31 is keep 1 (1, 2, 3, 4, 5)
    # 32    is keep 0 ()
    
    storage.mode(myCards) <- "integer"
    
    keepCol <- matrix(data=TRUE, nrow=length(idxKeep), ncol=5)
    
    keepCol[, 1] <- idxKeep %in% c(1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 12, 17, 18, 19, 20, 27)
    keepCol[, 2] <- idxKeep %in% c(1, 2, 3, 4, 6, 7, 8, 9, 13, 14, 15, 17, 21, 22, 23, 28)
    keepCol[, 3] <- idxKeep %in% c(1, 2, 3, 5, 6, 7, 10, 11, 13, 14, 16, 18, 21, 24, 25, 29)
    keepCol[, 4] <- idxKeep %in% c(1, 2, 4, 5, 6, 8, 10, 12, 13, 15, 16, 19, 22, 24, 26, 30)
    keepCol[, 5] <- idxKeep %in% c(1, 3, 4, 5, 6, 9, 11, 12, 14, 15, 16, 20, 23, 25, 26, 31)
    
    myCards[!keepCol] <- NA_integer_
    
    myCards
}

diffHolds <- function(holdA, holdB) {
    holdA[is.na(holdA)] <- -1L
    holdB[is.na(holdB)] <- -1L
    
    deltaHolds <- rowSums(abs(holdA - holdB)) > 0
    
    deltaHolds
}

jb96Holds <- findHolds(idxKeep=jb96List$tempSmallMax[2, ])
bp85Holds <- findHolds(idxKeep=bp85List$tempSmallMax[2, ])
jb85Holds <- findHolds(idxKeep=jb85List$tempSmallMax[2, ])
bpd96Holds <- findHolds(idxKeep=bpd96List$tempSmallMax[2, ])
ddb96Holds <- findHolds(idxKeep=ddb96List$tempSmallMax[2, ])
tdb96Holds <- findHolds(idxKeep=tdb96List$tempSmallMax[2, ])

# Compare JB 96 and BP 85
jb96_vs_bp85Holds <- diffHolds(jb96Holds, bp85Holds)
sum(jb96_vs_bp85Holds)
## [1] 721
if (sum(jb96_vs_bp85Holds) > 0) { 
    cbind(cardSmall[jb96_vs_bp85Holds, ], 
          jb96Holds[jb96_vs_bp85Holds, ], 
          bp85Holds[jb96_vs_bp85Holds, ]
          )[sort(sample(1:sum(jb96_vs_bp85Holds), 20)), ]
}
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
##  [1,]    1    5   10   13   23    1    5   10   13    NA     1    NA    10
##  [2,]    1    4   23   25   28   NA   NA   23   25    NA     1    NA    NA
##  [3,]    1    2   10   12   26    1    2   10   12    NA     1    NA    10
##  [4,]   10   12   14   29   43   10   12   NA   NA    NA    NA    12    14
##  [5,]    1    3    7   23   25   NA   NA   NA   23    25     1    NA    NA
##  [6,]   11   12   14   26   31   11   12   NA   NA    NA    11    12    14
##  [7,]    6    8   23   25   27   NA   NA   23   25    NA    NA    NA    NA
##  [8,]    1    6   10   12   24    1    6   10   12    NA     1    NA    10
##  [9,]    2    3    5   24   38    2    3    5   NA    NA    NA    NA    NA
## [10,]    3   10   13   15   32   NA   10   13   NA    NA    NA    NA    13
## [11,]    3   10   13   15   21   NA   10   13   NA    NA    NA    NA    13
## [12,]    7    9   11   15   38    7    9   11   NA    NA    NA    NA    11
## [13,]    3   10   13   19   33   NA   10   13   NA    NA    NA    NA    13
## [14,]    8   10   13   16   20   NA   10   13   NA    NA    NA    NA    13
## [15,]   10   11   21   26   31   10   11   NA   NA    NA    NA    11    NA
## [16,]   10   11   18   34   52   10   11   NA   NA    NA    NA    11    NA
## [17,]    8    9   12   19   37    8    9   12   NA    NA    NA    NA    12
## [18,]   10   11   19   26   35   10   11   NA   NA    NA    NA    11    NA
## [19,]    7    8    9   24   26    7    8    9   NA    NA    NA    NA    NA
## [20,]    7   10   11   21   38    7   10   11   NA    NA    NA    NA    11
##       [,14] [,15]
##  [1,]    13    NA
##  [2,]    25    NA
##  [3,]    12    NA
##  [4,]    NA    NA
##  [5,]    NA    25
##  [6,]    26    NA
##  [7,]    25    27
##  [8,]    12    NA
##  [9,]    24    38
## [10,]    NA    NA
## [11,]    NA    NA
## [12,]    NA    38
## [13,]    NA    NA
## [14,]    NA    NA
## [15,]    26    NA
## [16,]    NA    52
## [17,]    NA    37
## [18,]    26    NA
## [19,]    24    26
## [20,]    NA    38
# Compare JB 96 and JB 85
jb96_vs_jb85Holds <- diffHolds(jb96Holds, jb85Holds)
sum(jb96_vs_jb85Holds)
## [1] 597
if (sum(jb96_vs_jb85Holds) > 0) { 
    cbind(cardSmall[jb96_vs_jb85Holds, ], 
          jb96Holds[jb96_vs_jb85Holds, ], 
          jb85Holds[jb96_vs_jb85Holds, ]
          )[sort(sample(1:sum(jb96_vs_jb85Holds), 20)), ]
}
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
##  [1,]    2    3    4   14   32    2    3    4   NA    NA    NA    NA    NA
##  [2,]    1    8   23   25   28   NA   NA   23   25    NA     1    NA    NA
##  [3,]   11   12   14   26   28   11   12   NA   NA    NA    11    12    14
##  [4,]   11   12   14   26   29   11   12   NA   NA    NA    11    12    14
##  [5,]    1    5   10   12   26    1    5   10   12    NA     1    NA    10
##  [6,]   11   12   14   26   34   11   12   NA   NA    NA    11    12    14
##  [7,]    7   10   13   15   18   NA   10   13   NA    NA    NA    NA    13
##  [8,]    2   10   13   18   21   NA   10   13   NA    NA    NA    NA    13
##  [9,]   10   11   22   26   28   10   11   NA   NA    NA    NA    11    NA
## [10,]    8   10   13   16   20   NA   10   13   NA    NA    NA    NA    13
## [11,]    7   10   13   16   34   NA   10   13   NA    NA    NA    NA    13
## [12,]    7    8   11   16   38    7    8   11   NA    NA    NA    NA    11
## [13,]   10   11   16   26   34   10   11   NA   NA    NA    NA    11    NA
## [14,]    4    5    6   24   25    4    5    6   NA    NA    NA    NA    NA
## [15,]    4    6    7   23   24    4    6    7   NA    NA    NA    NA    NA
## [16,]    6   10   13   17   20   NA   10   13   NA    NA    NA    NA    13
## [17,]   10   11   17   26   35   10   11   NA   NA    NA    NA    11    NA
## [18,]    8    9   12   18   24    8    9   12   NA    NA    NA    NA    12
## [19,]    7   10   13   19   34   NA   10   13   NA    NA    NA    NA    13
## [20,]    6    9   23   24   39   NA   NA   23   24    NA    NA    NA    NA
##       [,14] [,15]
##  [1,]    14    NA
##  [2,]    25    NA
##  [3,]    26    NA
##  [4,]    26    NA
##  [5,]    12    NA
##  [6,]    26    NA
##  [7,]    NA    NA
##  [8,]    NA    NA
##  [9,]    26    NA
## [10,]    NA    NA
## [11,]    NA    NA
## [12,]    NA    38
## [13,]    26    NA
## [14,]    24    25
## [15,]    23    24
## [16,]    NA    NA
## [17,]    26    NA
## [18,]    NA    24
## [19,]    NA    NA
## [20,]    24    39
# Compare BP 85 and JB 85
bp85_vs_jb85Holds <- diffHolds(bp85Holds, jb85Holds)
sum(bp85_vs_jb85Holds)
## [1] 124
if (sum(bp85_vs_jb85Holds) > 0) { 
    cbind(cardSmall[bp85_vs_jb85Holds, ], 
          bp85Holds[bp85_vs_jb85Holds, ], 
          jb85Holds[bp85_vs_jb85Holds, ]
          )[sort(sample(1:sum(bp85_vs_jb85Holds), 20)), ]
}
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
##  [1,]    2    3    4   14   34   NA   NA   NA   14    NA     2     3     4
##  [2,]    2    3    4   14   36   NA   NA   NA   14    NA     2     3     4
##  [3,]    1    2   23   25   29    1   NA   NA   25    NA    NA    NA    23
##  [4,]    2    3   23   25   27   NA   NA   NA   25    27    NA    NA    23
##  [5,]    2    4    5   14   19   NA   NA   NA   14    NA     2     4     5
##  [6,]    2    4    5   14   37   NA   NA   NA   14    37     2     4     5
##  [7,]    2    4    5   14   39   NA   NA   NA   14    39     2     4     5
##  [8,]    1    2   23   25   32    1   NA   NA   25    NA    NA    NA    23
##  [9,]    2    6   23   25   27   NA   NA   NA   25    27    NA    NA    23
## [10,]    1    2   23   25   33    1   NA   NA   25    NA    NA    NA    23
## [11,]    1    7   23   25   28    1   NA   NA   25    NA    NA    NA    23
## [12,]    1    3   23   25   30    1   NA   NA   25    NA    NA    NA    23
## [13,]    1    4   23   25   29    1   NA   NA   25    NA    NA    NA    23
## [14,]    3    4   23   25   27   NA   NA   NA   25    27    NA    NA    23
## [15,]    4    6   23   25   27   NA   NA   NA   25    27    NA    NA    23
## [16,]    1    5    7   23   25    1   NA   NA   NA    25    NA    NA    NA
## [17,]   10   12   14   31   46   NA   12   14   NA    NA    10    12    NA
## [18,]    6    7    9   14   36   NA   NA   NA   14    NA     6     7     9
## [19,]    1    7   23   25   32    1   NA   NA   25    NA    NA    NA    23
## [20,]    6    7   23   25   27   NA   NA   NA   25    27    NA    NA    23
##       [,14] [,15]
##  [1,]    NA    NA
##  [2,]    NA    NA
##  [3,]    25    NA
##  [4,]    25    NA
##  [5,]    NA    NA
##  [6,]    NA    NA
##  [7,]    NA    NA
##  [8,]    25    NA
##  [9,]    25    NA
## [10,]    25    NA
## [11,]    25    NA
## [12,]    25    NA
## [13,]    25    NA
## [14,]    25    NA
## [15,]    25    NA
## [16,]    23    25
## [17,]    NA    NA
## [18,]    NA    NA
## [19,]    25    NA
## [20,]    25    NA
# Compare JB 96 and DDB 96
jb96_vs_ddb96Holds <- diffHolds(jb96Holds, ddb96Holds)
sum(jb96_vs_ddb96Holds)
## [1] 13077
if (sum(jb96_vs_ddb96Holds) > 0) { 
    cbind(cardSmall[jb96_vs_ddb96Holds, ], 
          jb96Holds[jb96_vs_ddb96Holds, ], 
          ddb96Holds[jb96_vs_ddb96Holds, ]
          )[sort(sample(1:sum(jb96_vs_ddb96Holds), 20)), ]
}
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
##  [1,]    1   12   14   17   38    1   12   14   NA    38     1    NA    14
##  [2,]    1    3    9   15   25    1   NA   NA   NA    25     1    NA    NA
##  [3,]    1    5   15   20   38    1   NA   NA   NA    38     1    NA    NA
##  [4,]    5    9   12   14   28   NA   NA   12   14    NA    NA    NA    NA
##  [5,]    2    9   12   14   21   NA   NA   12   14    NA    NA    NA    NA
##  [6,]    4    9   13   14   16   NA   NA   13   14    NA    NA    NA    NA
##  [7,]    3    6   18   25   27   NA   NA   NA   25    27    NA    NA    NA
##  [8,]    1    3   10   18   25    1   NA   NA   NA    25     1    NA    NA
##  [9,]    6    7   11   14   29   NA   NA   11   14    NA    NA    NA    NA
## [10,]    1    6    9   16   25    1   NA   NA   NA    25     1    NA    NA
## [11,]    1    5   17   35   50    1   NA   NA   NA    50     1    NA    NA
## [12,]    1    7   17   24   36    1   NA   NA   24    NA     1    NA    NA
## [13,]    1    8   19   33   52    1   NA   NA   NA    52     1    NA    NA
## [14,]    1    6   20   26   35    1   NA   NA   26    NA     1    NA    NA
## [15,]    8   10   20   25   27   NA   NA   NA   25    27    NA    NA    NA
## [16,]    7   10   14   34   51   NA   NA   14   NA    51    NA    NA    14
## [17,]    2    3    8   17   32   NA   NA   NA   NA    NA     2     3    NA
## [18,]    4   10   13   15   31   NA   10   13   NA    NA     4    10    13
## [19,]    7   10   13   15   34   NA   10   13   NA    NA     7    10    13
## [20,]    4    8   18   22   33   NA   NA   NA   NA    NA     4     8    18
##       [,14] [,15]
##  [1,]    NA    NA
##  [2,]    NA    NA
##  [3,]    NA    NA
##  [4,]    14    NA
##  [5,]    14    NA
##  [6,]    14    NA
##  [7,]    NA    27
##  [8,]    NA    NA
##  [9,]    14    NA
## [10,]    NA    NA
## [11,]    NA    NA
## [12,]    NA    NA
## [13,]    NA    NA
## [14,]    NA    NA
## [15,]    NA    27
## [16,]    NA    NA
## [17,]    17    32
## [18,]    NA    NA
## [19,]    NA    NA
## [20,]    NA    33
# Compare JB 96 and BPD 96
jb96_vs_bpd96Holds <- diffHolds(jb96Holds, bpd96Holds)
sum(jb96_vs_bpd96Holds)
## [1] 3036
if (sum(jb96_vs_bpd96Holds) > 0) { 
    cbind(cardSmall[jb96_vs_bpd96Holds, ], 
          jb96Holds[jb96_vs_bpd96Holds, ], 
          bpd96Holds[jb96_vs_bpd96Holds, ]
          )[sort(sample(1:sum(jb96_vs_bpd96Holds), 20)), ]
}
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
##  [1,]    2    6   10   14   37   NA   NA   NA   14    37    NA    NA    NA
##  [2,]    1    5   11   23   39    1   NA   11   NA    NA     1    NA    11
##  [3,]    8   11   14   35   51   NA   11   NA   NA    51     8    11    NA
##  [4,]    3    6   18   20   28   NA   NA   NA   NA    NA     3     6    18
##  [5,]    2    5   19   21   29   NA   NA   NA   NA    NA     2     5    19
##  [6,]    2    5   16   22   32   NA   NA   NA   NA    NA     2     5    16
##  [7,]    2    6   18   22   30   NA   NA   NA   NA    NA     2     6    18
##  [8,]    8    9   15   25   37   NA   NA   NA   25    37     8     9    NA
##  [9,]    2    9   13   23   24   NA   NA   NA   23    24    NA     9    13
## [10,]    3    5   17   20   35   NA   NA   NA   NA    NA     3     5    17
## [11,]    4    5   10   16   20   NA   NA   NA   NA    NA     4     5    NA
## [12,]    6    7   17   21   29   NA   NA   NA   NA    NA     6     7    17
## [13,]    3    7   10   17   19   NA   NA   NA   NA    NA     3     7    NA
## [14,]    3    6   10   20   34   NA   NA   NA   NA    NA    NA     6    10
## [15,]    7    8   19   23   29   NA   NA   NA   NA    NA     7     8    19
## [16,]    6    7   16   34   49   NA   NA   NA   NA    NA     6     7    NA
## [17,]    6   10   13   16   34   NA   10   13   NA    NA    NA    NA    13
## [18,]    4    6   20   22   36   NA   NA   NA   NA    NA    NA     6    20
## [19,]    8   10   13   17   20   NA   10   13   NA    NA    NA    NA    13
## [20,]    6   11   21   25   35   NA   11   NA   25    NA    NA    11    21
##       [,14] [,15]
##  [1,]    NA    37
##  [2,]    23    39
##  [3,]    35    51
##  [4,]    20    NA
##  [5,]    NA    29
##  [6,]    NA    32
##  [7,]    NA    30
##  [8,]    25    37
##  [9,]    23    24
## [10,]    20    NA
## [11,]    16    20
## [12,]    21    NA
## [13,]    17    19
## [14,]    20    34
## [15,]    23    NA
## [16,]    34    49
## [17,]    NA    NA
## [18,]    22    36
## [19,]    NA    NA
## [20,]    25    35
# Compare TDB 96 and DDB 96
tdb96_vs_ddb96Holds <- diffHolds(tdb96Holds, ddb96Holds)
sum(tdb96_vs_ddb96Holds)
## [1] 7376
if (sum(tdb96_vs_ddb96Holds) > 0) { 
    cbind(cardSmall[tdb96_vs_ddb96Holds, ], 
          tdb96Holds[tdb96_vs_ddb96Holds, ], 
          ddb96Holds[tdb96_vs_ddb96Holds, ]
          )[sort(sample(1:sum(tdb96_vs_ddb96Holds), 20)), ]
}
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
##  [1,]    4   11   17   30   41    4   NA   17   30    41     4    NA    17
##  [2,]    5    6    8   21   33    5    6    8   NA    33    NA    NA     8
##  [3,]    7    9   21   22   32    7    9   21   NA    32    NA     9    NA
##  [4,]   10   12   13   22   26   10   12   13   NA    NA    NA    NA    13
##  [5,]    3   11   20   25   27   NA   NA   NA   NA    27    NA    11    NA
##  [6,]    1    7   11   17   26    1    7   11   NA    NA     1    NA    11
##  [7,]    1   13   17   36   50    1   13   NA   36    50     1    13    NA
##  [8,]    1    7   12   21   26    1    7   12   NA    NA     1    NA    12
##  [9,]   12   13   14   35   49   12   13   14   NA    49    12    13    NA
## [10,]    4    6   12   15   29    4    6   12   NA    NA    NA    NA    12
## [11,]    2    4    7   16   35    2    4    7   NA    NA    NA    NA    NA
## [12,]    2    3    7   18   21    2    3    7   NA    NA    NA    NA    NA
## [13,]    2    4    9   18   20    2    4    9   NA    NA    NA    NA    NA
## [14,]    2    5   12   21   22    2    5   12   NA    NA    NA    NA    12
## [15,]    3    4   10   21   35    3    4   10   NA    NA    NA    NA    NA
## [16,]    3    9   11   18   19    3    9   11   NA    NA    NA    NA    11
## [17,]    3   11   18   25   36   NA   11   NA   25    36    NA    11    NA
## [18,]    5    9   13   17   34    5    9   13   NA    NA    NA    NA    13
## [19,]    4    7   13   19   21    4    7   13   NA    NA    NA    NA    13
## [20,]    7   10   18   25   37   NA   10   NA   25    37    NA    NA    NA
##       [,14] [,15]
##  [1,]    30    NA
##  [2,]    21    NA
##  [3,]    22    NA
##  [4,]    NA    26
##  [5,]    25    NA
##  [6,]    NA    NA
##  [7,]    NA    NA
##  [8,]    NA    NA
##  [9,]    NA    NA
## [10,]    NA    NA
## [11,]    NA    NA
## [12,]    NA    NA
## [13,]    NA    NA
## [14,]    NA    NA
## [15,]    NA    NA
## [16,]    NA    NA
## [17,]    25    NA
## [18,]    NA    NA
## [19,]    NA    NA
## [20,]    25    37

Next, a sampling of hands is taken assuming only the cards on the deal (draw assumed to provide exactly the EV of the deal; essentially n-play as n -> +Inf). First, a function is written:

simDrawOnly <- function(useList, useWeight=cardWeight, nCards=1000, nSims=10) {
    # gameHold <- vector("list", length=nSims)
    gameHold <- base::sample(rep(useList$tempSmallMax[1, ], times=useWeight), 
                                           nCards*nSims, replace=TRUE
                                           )
    gameCtr <- rep(1:nSims, each=nCards)
    
    # for (intCtr in 1:nSims) {
    #     gameHold[[intCtr]] <- base::sample(rep(useList$tempSmallMax[1, ], times=useWeight), 
    #                                        nCards, replace=TRUE
    #                                        )
    # }
    
    gameResults <- tapply(gameHold, gameCtr, FUN=sum)
    gameMins <- tapply(gameHold, gameCtr, FUN=function(x) { min(cumsum(x)) })
    
    print(summary(gameResults))
    print(summary(gameMins))
    
    list(totalSum=gameResults, worstSum=gameMins)
}

Then, a 40,000 x 2,000 simulation is run for each of seven game types, with the results cached to improve run times:

nDeals <- 40000

jb96SimDraw <- simDrawOnly(useList=jb96List, nCards=nDeals, nSims=2000)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -832.20 -358.80 -220.80 -182.80  -62.75 1774.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -855.6000 -408.4000 -293.1000 -299.6000 -171.3000    0.6011
jb85SimDraw <- simDrawOnly(useList=jb85List, nCards=nDeals, nSims=2000)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1747.0 -1250.0 -1117.0 -1081.0  -977.0   705.4 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1747.00 -1268.00 -1136.00 -1117.00  -999.50   -78.88
bp85SimDraw <- simDrawOnly(useList=bp85List, nCards=nDeals, nSims=2000)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1108.0  -519.7  -365.1  -345.4  -226.0  1644.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1137.000  -561.100  -419.900  -433.500  -297.800    -5.908
bpd96SimDraw <- simDrawOnly(useList=bpd96List, nCards=nDeals, nSims=2000)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1141.00  -420.30  -191.90  -161.10    55.06  1821.00 
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -1199.0000  -525.8000  -350.7000  -370.5000  -190.3000    -0.6652
ddb96SimDraw <- simDrawOnly(useList=ddb96List, nCards=nDeals, nSims=2000)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1551.0  -712.6  -433.5  -397.0  -132.1  1545.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1553.000  -794.500  -569.300  -583.200  -353.500    -2.571
tdb96SimDraw <- simDrawOnly(useList=tdb96List, nCards=nDeals, nSims=2000)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -2389.0 -1215.0  -850.3  -760.5  -381.6  2893.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -2398.000 -1297.000 -1001.000  -986.700  -665.700     3.738

The histograms and associated summary statistics are examined and compared:

fmtDeals <- prettyNum(nDeals, big.mark=",")

# JB 96 vs BP 85
hist(pmin(jb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(1, 0, 0, 0.4), 
     main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"), 
     xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
     )
hist(pmin(bp85SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(0, 0, 1, 0.4), add=TRUE
     )
legend("topright", pch=19, legend=c("JB 96", "BP 85", "Overlap"), 
       col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
       )

# JB 96 vs JB 85
hist(pmin(jb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(1, 0, 0, 0.4), 
     main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"), 
     xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
     )
hist(pmin(jb85SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(0, 0, 1, 0.4), add=TRUE
     )
legend("topright", pch=19, legend=c("JB 96", "JB 85", "Overlap"), 
       col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
       )

# JB 96 vs BPD 96
hist(pmin(jb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(1, 0, 0, 0.4), 
     main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"), 
     xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
     )
hist(pmin(bpd96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(0, 0, 1, 0.4), add=TRUE
     )
legend("topright", pch=19, legend=c("JB 96", "BPD 96", "Overlap"), 
       col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
       )

# JB 96 vs DDB 96
hist(pmin(jb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(1, 0, 0, 0.4), 
     main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"), 
     xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
     )
hist(pmin(ddb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(0, 0, 1, 0.4), add=TRUE
     )
legend("topright", pch=19, legend=c("JB 96", "DDB 96", "Overlap"), 
       col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
       )

# DDB 96 vs TDB 96
hist(pmin(ddb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(1, 0, 0, 0.4), 
     main=paste0("Cumulative Returns (deal-only EV) for ", fmtDeals, " Hands"), 
     xlab=paste0("Cumulative Return after ", fmtDeals, " Hands (capped at 20%)")
     )
hist(pmin(tdb96SimDraw$totalSum/nDeals, 0.2), breaks=seq(-0.1, 0.2, by=0.005), 
     col=rgb(0, 0, 1, 0.4), add=TRUE
     )
legend("topright", pch=19, legend=c("DDB 96", "TDB 96", "Overlap"), 
       col=c(rgb(1, 0, 0, 0.4), rgb(0, 0, 1, 0.4), rgb(0.5, 0, 0.5, 0.6))
       )

# Comparisons of percentiles
keyQuant <- c(0.01, 0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95, 0.99)

jb96Quant <- quantile(jb96SimDraw$totalSum/nDeals, keyQuant)
jb85Quant <- quantile(jb85SimDraw$totalSum/nDeals, keyQuant)
bp85Quant <- quantile(bp85SimDraw$totalSum/nDeals, keyQuant)
bpd96Quant <- quantile(bpd96SimDraw$totalSum/nDeals, keyQuant)
ddb96Quant <- quantile(ddb96SimDraw$totalSum/nDeals, keyQuant)
tdb96Quant <- quantile(tdb96SimDraw$totalSum/nDeals, keyQuant)

allQuant <- cbind(jb85Quant, jb96Quant, bp85Quant, bpd96Quant, ddb96Quant, tdb96Quant)

xBounds <- c(floor(50*min(allQuant))/50, ceiling(50*max(allQuant))/50)

# Plot the 1%
plot(y=1:ncol(allQuant), x=allQuant[1, ], type="l", lty=2, col="red", xlim=xBounds,
     ylab="Game Type", yaxt="n", main="Percentiles by Game", 
     xlab=paste0("EV of Deal-Only at ", fmtDeals, " Hands") 
     )
axis(2, at=6:1, labels=c("TDB 96", "DDB 96", "BPD 96", "BP 85", "JB 96","JB 85"), cex.axis=0.8)
points(y=1:ncol(allQuant), x=allQuant[1, ], pch=19, cex=2, col="red")

# Plot the 5%
lines(y=1:ncol(allQuant), x=allQuant[2, ], lty=2, col="orange")
points(y=1:ncol(allQuant), x=allQuant[2, ], lty=2, col="orange", pch=19, cex=2)

# Plot the 10%
lines(y=1:ncol(allQuant), x=allQuant[3, ], lty=2, col="purple")
points(y=1:ncol(allQuant), x=allQuant[3, ], lty=2, col="purple", pch=19, cex=2)

# Plot the 50%
lines(y=1:ncol(allQuant), x=allQuant[5, ], lty=2, col="black")
points(y=1:ncol(allQuant), x=allQuant[5, ], lty=2, col="black", pch=19, cex=2)

# Plot the 75%
lines(y=1:ncol(allQuant), x=allQuant[6, ], lty=2, col="dark blue")
points(y=1:ncol(allQuant), x=allQuant[6, ], lty=2, col="dark blue", pch=19, cex=2)

# Plot the 95%
lines(y=1:ncol(allQuant), x=allQuant[8, ], lty=2, col="dark green")
points(y=1:ncol(allQuant), x=allQuant[8, ], lty=2, col="dark green", pch=19, cex=2)

legend("bottomright", legend=c("1%", "5%", "10%", "50%", "75%", "95%"),
       col=c("red", "orange", "purple", "black", "dark blue", "dark green"),
       lty=2, pch=19
       )

# Show ratios
round(allQuant[1:5, ] / allQuant[1:5, 2], 2)
##     jb85Quant jb96Quant bp85Quant bpd96Quant ddb96Quant tdb96Quant
## 1%       2.26         1      1.27       1.35       1.82       2.82
## 5%       2.62         1      1.33       1.29       1.91       3.09
## 10%      2.83         1      1.37       1.25       1.89       3.13
## 25%      3.48         1      1.45       1.17       1.99       3.38
## 50%      5.06         1      1.65       0.87       1.96       3.85

Next, a single game type is simulated through various numbers of hands, with percentiles assessed. For starters, a function is built:

simPercentile <- function(keyList, useName, 
                          runSims=2000, 
                          useQuant=c(0.01, 0.05, 0.1, 0.25, 0.5, 0.75, 0.9, 0.95, 0.99), 
                          yVal=c(500, 1000, 2000, 4000, 8000, 16000, 25000, 40000), 
                          ptCol=c("red", "pink", "orange", "purple", "black", 
                                  "blue", "light green", "dark green", "grey"
                                  )
                          ) {

    keySim <- vector("list", length(yVal))
    keyQuants <- vector("list", length(yVal))

    for (intCtr in seq_along(yVal)) {
        keySim[[intCtr]] <- simDrawOnly(useList=keyList, nCards=yVal[intCtr], nSims=runSims)
        keyQuants[[intCtr]] <- quantile(keySim[[intCtr]]$totalSum/yVal[intCtr], useQuant)
    }

    xVal <- sapply(keyQuants, FUN=function(x) { x })
    
    plot(x=as.vector(xVal), y=log10(rep(yVal, each=length(useQuant))), 
         col=rep(ptCol, times=length(useQuant)), ylab="Log 10 (# Hands Dealt)", 
         xlab="EV of Deal-Only", main=paste0(useName, ": EV of Deal-Only Components"),
         pch=19, ylim=c(log10(0.5 * min(yVal)), log10(2 * max(yVal)))
        )
    legend("top", col=ptCol, pch=19, ncol=length(useQuant), 
           legend=paste0(100*useQuant, "%")
           )

    list(keySim=keySim, keyQuants=keyQuants)
}

Next, the JB 96 game is simulated, with results cached for later usage:

set.seed(1611260741)
jb96Sim <- simPercentile(keyList=jb96List, useName="JB 96")
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -65.850 -18.570  -3.225  -1.697  11.220 820.800 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -69.280 -25.800 -15.430 -17.520  -7.689   9.464 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -105.600  -28.290   -7.074   -4.168   14.110  839.000 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -109.500  -38.410  -23.690  -26.470  -11.800    4.335 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -165.800  -40.720  -12.560   -8.688   19.120  872.100 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -166.400  -56.020  -36.770  -40.090  -18.260    2.807 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -214.90  -67.36  -27.25  -21.09   19.64  890.20 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -217.600  -90.640  -57.440  -62.550  -28.250    3.302 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -329.00 -107.80  -50.04  -39.02   13.17  881.00 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -336.200 -136.200  -88.690  -97.530  -51.370    2.115 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -445.600 -175.400  -95.370  -80.520   -7.372 1242.000 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -463.4000 -213.8000 -145.8000 -155.2000  -83.5100   -0.5029 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -625.00 -246.80 -141.20 -112.60  -24.85 1607.00 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -625.800 -289.400 -198.000 -210.200 -116.200   -1.782 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -803.20 -343.50 -213.30 -183.70  -71.69 1294.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -846.1000 -403.0000 -287.2000 -296.4000 -180.9000    0.8879

Then, the BP 85 game is simulated, with results cached for later usage:

set.seed(2016112607)
bp85Sim <- simPercentile(keyList=bp85List, useName="BP 85")
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -70.880 -21.150  -6.846  -5.024   9.218 108.700 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -70.880 -28.290 -17.310 -19.390  -8.942  25.640 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -101.40  -31.23  -11.52   -8.35   10.21  815.80 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -104.500  -42.040  -26.740  -29.310  -14.620    7.813 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -165.600  -51.460  -23.050  -17.850    9.316  823.700 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -167.500  -66.440  -42.460  -46.340  -23.480    3.347 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -253.500  -85.230  -37.630  -32.160    7.131  893.400 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -257.400 -102.500  -66.320  -72.690  -37.150    3.241 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -356.90 -141.00  -79.47  -68.55  -13.03  846.80 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -381.20 -167.70 -114.70 -121.00  -67.79   18.15 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -536.10 -238.00 -148.60 -125.70  -51.19 1578.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -591.9000 -269.8000 -193.0000 -198.8000 -116.5000   -0.0156 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -796.6  -346.6  -230.2  -198.1  -104.4  1540.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -828.9000 -387.0000 -278.8000 -286.6000 -178.3000   -0.2586 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -990.0  -514.1  -368.7  -334.7  -207.3  1322.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1017.000  -560.700  -430.000  -429.300  -292.300    -5.151

Then, the DDB 96 game is simulated, with results cached for later usage:

set.seed(1126201607)
ddb96Sim <- simPercentile(keyList=ddb96List, useName="DDB 96")
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -92.630 -30.700 -12.020  -3.662  10.510 783.200 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -92.63  -38.97  -25.24  -26.98  -12.86   10.31 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -131.800  -48.640  -20.680   -6.814   13.940  841.800 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -137.600  -58.780  -38.470  -41.850  -20.670    4.366 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -216.30  -77.12  -35.12  -18.04   15.47 1209.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -218.5000  -94.1900  -63.7000  -67.3900  -35.7600    0.8994 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -313.60 -130.50  -67.31  -45.17   16.77  956.20 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -316.00 -155.40 -103.00 -108.90  -56.88   12.83 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -480.900 -211.500 -113.300  -81.930    5.208 1139.000 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -482.20 -249.90 -170.60 -177.80  -97.98   17.75 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -804.10 -353.40 -200.60 -163.60  -25.92 1538.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -826.3000 -407.2000 -285.8000 -293.8000 -168.4000    0.2324 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1179.00  -485.40  -302.40  -254.90   -73.42  1360.00 
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -1213.0000  -555.5000  -402.5000  -406.1000  -248.8000    -0.1293 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1664.0  -710.4  -448.7  -409.6  -153.6  1997.0 
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -1666.0000  -794.0000  -569.7000  -583.8000  -356.7000    -0.8331

Then, the BPD 96 game is simulated, with results cached for later usage:

set.seed(1127201606)
bpd96Sim <- simPercentile(keyList=bpd96List, useName="BPD 96")
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -87.53  -28.70   -9.91   -3.54   11.28  816.70 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -88.060 -35.970 -22.890 -25.060 -11.520   4.893 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -130.90  -40.44  -12.67   -2.53   25.18  798.60 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -131.20  -53.36  -34.42  -37.10  -16.51   54.48 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -217.400  -61.410  -17.430   -7.049   36.710  887.200 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -219.000  -81.410  -50.090  -56.000  -26.060    3.679 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -300.60  -93.09  -27.62  -11.56   54.59  938.40 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -300.6000 -127.5000  -77.3600  -87.6000  -39.8800    0.5293 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -485.30 -133.20  -35.22  -25.74   64.17 1070.00 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -491.000 -183.400 -116.600 -128.300  -60.060    5.643 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -707.20 -211.20  -81.02  -54.85   63.84 1366.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -712.7000 -279.0000 -181.5000 -197.1000  -96.8400    0.2128 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -911.90 -275.50  -92.70  -79.82   77.52 1947.00 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -914.100 -375.700 -231.100 -259.100 -121.200    2.602 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1192.00  -415.20  -193.50  -152.00    76.34  1745.00 
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -1221.0000  -523.9000  -339.9000  -362.5000  -170.5000    -0.0564

Then, the TDB 96 game is simulated, with results cached for later usage:

set.seed(16112706)
tdb96Sim <- simPercentile(keyList=tdb96List, useName="TDB 96")
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -102.900  -41.560  -20.650   -8.395    1.527  826.400 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -104.30  -48.37  -33.51  -34.81  -18.73   13.45 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -162.000  -69.090  -39.570  -16.890   -2.079  910.900 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -162.000  -79.360  -55.380  -56.340  -30.320    4.836 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -247.20 -118.70  -69.58  -36.35   -9.74 1070.00 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -247.700 -134.700  -94.430  -97.030  -57.320    2.565 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -486.60 -203.40 -128.50  -74.82  -15.42 1423.00 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -494.700 -221.800 -165.100 -164.700 -103.600    3.456 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -689.200 -343.900 -210.100 -140.900   -9.978 1155.000 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -764.0000 -377.2000 -278.0000 -274.3000 -162.0000   -0.3811 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1161.00  -590.70  -388.60  -300.20   -80.31  2587.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1163.000  -643.800  -481.800  -477.500  -301.700    -0.568 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1548.0  -843.7  -530.5  -443.0  -119.9  2450.0 
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -1591.0000  -910.0000  -670.0000  -661.7000  -406.8000     0.4446 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -2534.0 -1217.0  -838.8  -750.5  -371.7  2233.0 
##       Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
## -2541.0000 -1313.0000  -985.1000  -981.4000  -652.5000    -0.2323

There are some interesting disconnects in the 99% EV of deal-only components, driven by the small possibilities of a nice pat hand. For example:

library(dplyr)

data.frame(rndScore=round(rep(jb96List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
    group_by(rndScore) %>%
    summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
    print.data.frame()
##    rndScore      ct      per
## 1        -1  865512      3.0
## 2         0 1189032      2.2
## 3         1  344328      7.5
## 4         2  123696     21.0
## 5         3   66096     39.3
## 6         5    4952    524.8
## 7         8    3744    694.2
## 8        17     608   4274.6
## 9        18     144  18048.3
## 10       19     184  14124.8
## 11       24     624   4165.0
## 12       49      36  72193.3
## 13      799       4 649740.0
data.frame(rndScore=round(rep(bp85List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
    group_by(rndScore) %>%
    summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
    print.data.frame()
##    rndScore      ct      per
## 1        -1  899100      2.9
## 2         0 1158420      2.2
## 3         1  341496      7.6
## 4         2  124500     20.9
## 5         3   48252     53.9
## 6         4   17624    147.5
## 7         6    4224    615.3
## 8         7    3744    694.2
## 9        17     752   3456.1
## 10       18      52  49980.0
## 11       19     132  19689.1
## 12       24     432   6016.1
## 13       39     144  18048.3
## 14       49      36  72193.3
## 15       79      48  54145.0
## 16      799       4 649740.0
data.frame(rndScore=round(rep(ddb96List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
    group_by(rndScore) %>%
    summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
    print.data.frame()
##    rndScore      ct      per
## 1        -1  924432      2.8
## 2         0 1384716      1.9
## 3         1  213276     12.2
## 4         2     144  18048.3
## 5         3   11184    232.4
## 6         4   38016     68.4
## 7         5    4952    524.8
## 8         6    5760    451.2
## 9         7    6912    376.0
## 10        8    3456    752.0
## 11       11    1992   1304.7
## 12       12    2520   1031.3
## 13       17     608   4274.6
## 14       18     144  18048.3
## 15       19     184  14124.8
## 16       49     468   5553.3
## 17       99     108  24064.4
## 18      159      36  72193.3
## 19      220      36  72193.3
## 20      399      12 216580.0
## 21      799       4 649740.0
data.frame(rndScore=round(rep(bpd96List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
    group_by(rndScore) %>%
    summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
    print.data.frame()
##    rndScore      ct      per
## 1        -1  924432      2.8
## 2         0 1131636      2.3
## 3         1  466356      5.6
## 4         2     144  18048.3
## 5         3   11184    232.4
## 6         5    4952    524.8
## 7         6   54912     47.3
## 8         8    3744    694.2
## 9        17     608   4274.6
## 10       18     144  18048.3
## 11       19     184  14124.8
## 12       49      36  72193.3
## 13       79     624   4165.0
## 14      799       4 649740.0
data.frame(rndScore=round(rep(tdb96List$tempSmallMax[1, ], times=cardWeight), 0)) %>%
    group_by(rndScore) %>%
    summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
    print.data.frame()
##    rndScore      ct      per
## 1        -1  930768      2.8
## 2         0 1379832      1.9
## 3         1  211824     12.3
## 4         2     144  18048.3
## 5         3   49200     52.8
## 6         5    4952    524.8
## 7         8   10152    256.0
## 8        10    5976    434.9
## 9        15    2520   1031.3
## 10       17     608   4274.6
## 11       18    2136   1216.7
## 12       19     184  14124.8
## 13       49     468   5553.3
## 14      161     108  24064.4
## 15      322      36  72193.3
## 16      399      36  72193.3
## 17      799      16 162435.0

With simulations of size X, the “1% cut-off” on average includes dealt hands occuring every 100*X times. For JB 96, dealt-hands with EV of 799 could be expected in the “1% cut-off” for simulations of size 6500+. So, at simulation size 8,000, there is an expected “bump” as this component is worth ~10% (799/8000). The “best 1%” line can be expected to jump to median+10%, since a sequence that has a dealt 799 but otherwise runs at median should now find its way near the lower portion of the top 1% (the 1% cut-off).

This effect is less evident for BP 85 and (especially) DDB 96 since with additional high-dealt-EV components, the impact of the dealt-royal is less impactful. For example, in DDB 96, the dealt Aces Kicker is worth half as much as the dealt Royal but occurs three times as often. So, merely obtaining a dealt Royal is much less likely to convert an otherwise mundane sequence to being in the “top 1%”.

This effect is more or less non-existent for BPD 96 (all quads +79) and TDB 96 (premium quads +399/+799) since there are a series of higher-frequency hands with good dealt-EV rather than an occasional hand with good dealt-EV. So, the top 1% will almost always include some good dealt hands for BPD 96 and TDB 96 even if the sample size is too small for a dealt RF.

Variance on the Draw

Much of the variance of the game occurs during the draw, as a particular hold may allow for anything from a Royal Flush through nothing, frequently with a few back-door good pays (e.g., getting the 3 cards needed to finish a Flush or Straight), many pushes (improving to a high pair), and a great many losses. The EV on the deal averages across all of these, masking a huge portion of the game’s variance. This is particularly salient when considering the impact of N-play (one dealt hand, one hold applied across hands, N independent draws without replacement scored).

For starters, calculating variance on the draw requires keeping all of the possible outcomes. The previous function (as well as its calls to functions) that used EVs is adapted to output a matrix of possible outcomes:

findFreq_YesRedraw <- function(useIdx, mtxIndices, aTypes) {
    # Assuming re-draw of thrown cards
    tmpScores <- data.frame(idx=as.vector(mtxIndices[, useIdx]), 
                            val=rep(as.integer(aTypes), times=length(useIdx))
                            )
    
    # Convert them to the relevant tbl_df (chkTidy will have idx and '0' through '25' as the columns)
    chkTidy <- tmpScores %>% 
        group_by(idx, val) %>% 
        summarize(ct=n()) %>% 
        spread(val, ct, fill=0)
    
    # Double check that the proper number of columns exist
    if (length(names(chkTidy)) != 27 | 
        names(chkTidy)[1] != "idx" |
        !isTRUE(all.equal(as.integer(names(chkTidy)[-1]), 0:25))
        ) {
        print(names(chkTidy))
        stop("The tidy process needs to produce a tbl_df with names 'idx' and then '0' through '25'")
    }
    
    # Return the thing as a matrix
    as.matrix(chkTidy)
}


calcFreq_YesRedraw <- function(mtxIndices, aTypes) {

    tmpEVkeep5 <- findFreq_YesRedraw(useIdx=1, mtxIndices=mtxIndices, aTypes=aTypes)
    tmpEVkeep4 <- findFreq_YesRedraw(useIdx=2:6, mtxIndices=mtxIndices, aTypes=aTypes)
    tmpEVkeep3 <- findFreq_YesRedraw(useIdx=7:16, mtxIndices=mtxIndices, aTypes=aTypes)
    tmpEVkeep2 <- findFreq_YesRedraw(useIdx=17:26, mtxIndices=mtxIndices, aTypes=aTypes)
    tmpEVkeep1 <- findFreq_YesRedraw(useIdx=27:31, mtxIndices=mtxIndices, aTypes=aTypes)
    tmpEVkeep0 <- findFreq_YesRedraw(useIdx=32, mtxIndices=mtxIndices, aTypes=aTypes)

    print(dim(tmpEVkeep5))
    print(dim(tmpEVkeep4))
    print(dim(tmpEVkeep3))
    print(dim(tmpEVkeep2))
    print(dim(tmpEVkeep1))
    print(dim(tmpEVkeep0))
    print(tmpEVkeep0)
    
    print(sum(tmpEVkeep5[, 1] != 1:choose(52,5)))
    print(sum(tmpEVkeep4[, 1] != 1:choose(52,4)))
    print(sum(tmpEVkeep3[, 1] != 1:choose(52,3)))
    print(sum(tmpEVkeep2[, 1] != 1:choose(52,2)))
    print(sum(tmpEVkeep1[, 1] != 1:choose(52,1)))
    print(sum(tmpEVkeep0[, 1] != 1:choose(52,0)))

    list(tmpEVkeep5=tmpEVkeep5, tmpEVkeep4=tmpEVkeep4, 
         tmpEVkeep3=tmpEVkeep3, tmpEVkeep2=tmpEVkeep2, 
         tmpEVkeep1=tmpEVkeep1, tmpEVkeep0=tmpEVkeep0
         )
}



drawNoReplace <- function(cardIndex, cardHolds, keyList, mtxIndices) {
    
    # cardHolds will come in small [by cardIndex] and should be used for filtering
    
    drawSmallNoReplace <- matrix(data=0L, nrow=length(cardIndex), ncol=ncol(keyList$tmpEVkeep5))
    
    tmpDrawkeep5 <- keyList$tmpEVkeep5
    tmpDrawkeep4 <- keyList$tmpEVkeep4
    tmpDrawkeep3 <- keyList$tmpEVkeep3
    tmpDrawkeep2 <- keyList$tmpEVkeep2
    tmpDrawkeep1 <- keyList$tmpEVkeep1
    tmpDrawkeep0 <- keyList$tmpEVkeep0
    
    # Manage the keep5 subset
    drawSmallNoReplace[cardHolds == 1, ] <- tmpDrawkeep5[cardIndex, ][cardHolds == 1, ]

    # Manage the keep4 subset
    # Keep 4 (intCtr: 2 is 1234, 3 is 1235, 4 is 1245, 5 is 1345, 6 is 2345)
    for (intCtr in 2:6) {
        drawSmallNoReplace[cardHolds == intCtr, -1] <- 
            tmpDrawkeep4[mtxIndices[cardIndex, intCtr], -1][cardHolds == intCtr, ] - 
            tmpDrawkeep5[cardIndex, ][cardHolds == intCtr, -1]
    }
    
    # Manage the keep3 subset
    # Keep 3 (intCtr: 7 is 123, 8 is 124, 9 is 125, 10 is 134, 11 is 135)
    # Keep 3 (intCtr: 12 is 145, 13 is 234, 14 is 235, 15 is 245, 16 is 345)
    # Take the results of the 3 cards assuming stand-alone
    # Subtract the results for each of the 4 cards (3 + 1 discard) assuming stand-alone
    # Add back the results of the 5 cards assuming stand-alone
    mapKeep3 <- data.frame(idx=7:16, 
                           keep1=c(2, 2, 3, 2, 3, 4, 2, 3, 4, 5), 
                           keep2=c(3, 4, 4, 5, 5, 5, 6, 6, 6, 6)
                           )
    
    for (intCtr in 7:16) {
        c1 <- mapKeep3$keep1[mapKeep3$idx == intCtr]
        c2 <- mapKeep3$keep2[mapKeep3$idx == intCtr]
        
        drawSmallNoReplace[cardHolds == intCtr, -1] <- 
            tmpDrawkeep3[mtxIndices[cardIndex, intCtr], -1][cardHolds == intCtr, ] -
            tmpDrawkeep4[mtxIndices[cardIndex, c1], -1][cardHolds == intCtr, ] -
            tmpDrawkeep4[mtxIndices[cardIndex, c2], -1][cardHolds == intCtr, ] +
            tmpDrawkeep5[cardIndex, ][cardHolds == intCtr, -1]        
    }
    

    # Manage the keep2 subset
    # Keep 2 (intCtr: 17 is 12, 18 is 13, 19 is 14, 20 is 15, 21 is 23)
    # Keep 2 (intCtr: 22 is 24, 23 is 25, 24 is 34, 25 is 35, 26 is 45)
    # Take the results of the 2 cards assuming stand-alone
    # Subtract the results of each of the 3 cards (2 + 1 discard) assuming stand-alone
    # Add back the results of each of the 4 cards (2 + 2 discard) assuming stand-alone
    # Subtract the results of the 5 cards assuming stand-alone
    mapKeep2 <- data.frame(idx=17:26, 
                           keep3_1=c(7,  7,  8,  9,  7,  8,  9, 10, 11, 12), 
                           keep3_2=c(8, 10, 10, 11, 13, 13, 14, 13, 14, 15),
                           keep3_3=c(9, 11, 12, 12, 14, 15, 15, 16, 16, 16),
                           keep4_1=c(2, 2, 2, 3, 2, 2, 3, 2, 3, 4),
                           keep4_2=c(3, 3, 4, 4, 3, 4, 4, 5, 5, 5),
                           keep4_3=c(4, 5, 5, 5, 6, 6, 6, 6, 6, 6)
                           )
    
    for (intCtr in 17:26) {
        c31 <- mapKeep2$keep3_1[mapKeep2$idx == intCtr]
        c32 <- mapKeep2$keep3_2[mapKeep2$idx == intCtr]
        c33 <- mapKeep2$keep3_3[mapKeep2$idx == intCtr]
    
        c41 <- mapKeep2$keep4_1[mapKeep2$idx == intCtr]
        c42 <- mapKeep2$keep4_2[mapKeep2$idx == intCtr]
        c43 <- mapKeep2$keep4_3[mapKeep2$idx == intCtr]
    
        drawSmallNoReplace[cardHolds == intCtr, -1] <- 
            tmpDrawkeep2[mtxIndices[cardIndex, intCtr], -1][cardHolds == intCtr, ] -
            tmpDrawkeep3[mtxIndices[cardIndex, c31], -1][cardHolds == intCtr, ] -
            tmpDrawkeep3[mtxIndices[cardIndex, c32], -1][cardHolds == intCtr, ] -
            tmpDrawkeep3[mtxIndices[cardIndex, c33], -1][cardHolds == intCtr, ] +
            tmpDrawkeep4[mtxIndices[cardIndex, c41], -1][cardHolds == intCtr, ] +
            tmpDrawkeep4[mtxIndices[cardIndex, c42], -1][cardHolds == intCtr, ] +
            tmpDrawkeep4[mtxIndices[cardIndex, c43], -1][cardHolds == intCtr, ] -
            tmpDrawkeep5[cardIndex, ][cardHolds == intCtr, -1]
    }
    

    # Manage the keep1 subset
    # Keep 1 (intCtr: 27 is 1, 28 is 2, 29 is 3, 30 is 4, 31 is 5)
    # Take the results of the 1 card assuming stand-alone
    # Subtract the results of the 2 cards (1 + 1 discard) assuming stand-alone
    # Add back the results of each of the 3 cards (1 + 2 discard) assuming stand-alone
    # Subtract the results of each of the 4 cards (1 + 3 discard) assuming stand-alone
    # Add back the results of the 5 cards assuming stand-alone
    mapKeep1 <- data.frame(idx=27:31,
                           keep2_1=c(17, 17, 18, 19, 20),
                           keep2_2=c(18, 21, 21, 22, 23),
                           keep2_3=c(19, 22, 24, 24, 25),
                           keep2_4=c(20, 23, 25, 26, 26),
                           keep3_1=c(7,   7,  7,  8,  9), 
                           keep3_2=c(8,   8, 10, 10, 11),
                           keep3_3=c(9,   9, 11, 12, 12),
                           keep3_4=c(10, 13, 13, 13, 14),
                           keep3_5=c(11, 14, 14, 15, 15),
                           keep3_6=c(12, 15, 16, 16, 16),
                           keep4_1=c(2, 2, 2, 2, 3),
                           keep4_2=c(3, 3, 3, 4, 4),
                           keep4_3=c(4, 4, 5, 5, 5),
                           keep4_4=c(5, 6, 6, 6, 6)
                           )
    
    for (intCtr in 27:31) {
        c21 <- mapKeep1$keep2_1[mapKeep1$idx == intCtr]
        c22 <- mapKeep1$keep2_2[mapKeep1$idx == intCtr]
        c23 <- mapKeep1$keep2_3[mapKeep1$idx == intCtr]
        c24 <- mapKeep1$keep2_4[mapKeep1$idx == intCtr]
    
        c31 <- mapKeep1$keep3_1[mapKeep1$idx == intCtr]
        c32 <- mapKeep1$keep3_2[mapKeep1$idx == intCtr]
        c33 <- mapKeep1$keep3_3[mapKeep1$idx == intCtr]
        c34 <- mapKeep1$keep3_4[mapKeep1$idx == intCtr]
        c35 <- mapKeep1$keep3_5[mapKeep1$idx == intCtr]
        c36 <- mapKeep1$keep3_6[mapKeep1$idx == intCtr]
    
        c41 <- mapKeep1$keep4_1[mapKeep1$idx == intCtr]
        c42 <- mapKeep1$keep4_2[mapKeep1$idx == intCtr]
        c43 <- mapKeep1$keep4_3[mapKeep1$idx == intCtr]
        c44 <- mapKeep1$keep4_4[mapKeep1$idx == intCtr]
        
        drawSmallNoReplace[cardHolds == intCtr, -1] <- 
            tmpDrawkeep1[mtxIndices[cardIndex, intCtr], -1][cardHolds == intCtr, ] -
            tmpDrawkeep2[mtxIndices[cardIndex, c21], -1][cardHolds == intCtr, ] -
            tmpDrawkeep2[mtxIndices[cardIndex, c22], -1][cardHolds == intCtr, ] -
            tmpDrawkeep2[mtxIndices[cardIndex, c23], -1][cardHolds == intCtr, ] -
            tmpDrawkeep2[mtxIndices[cardIndex, c24], -1][cardHolds == intCtr, ] +
            tmpDrawkeep3[mtxIndices[cardIndex, c31], -1][cardHolds == intCtr, ] +
            tmpDrawkeep3[mtxIndices[cardIndex, c32], -1][cardHolds == intCtr, ] +
            tmpDrawkeep3[mtxIndices[cardIndex, c33], -1][cardHolds == intCtr, ] +
            tmpDrawkeep3[mtxIndices[cardIndex, c34], -1][cardHolds == intCtr, ] +
            tmpDrawkeep3[mtxIndices[cardIndex, c35], -1][cardHolds == intCtr, ] +
            tmpDrawkeep3[mtxIndices[cardIndex, c36], -1][cardHolds == intCtr, ] -
            tmpDrawkeep4[mtxIndices[cardIndex, c41], -1][cardHolds == intCtr, ] -
            tmpDrawkeep4[mtxIndices[cardIndex, c42], -1][cardHolds == intCtr, ] -
            tmpDrawkeep4[mtxIndices[cardIndex, c43], -1][cardHolds == intCtr, ] -
            tmpDrawkeep4[mtxIndices[cardIndex, c44], -1][cardHolds == intCtr, ] +
            tmpDrawkeep5[cardIndex, ][cardHolds == intCtr, -1]
    }
    

    # Manage the keep0 subset
    # Keep 0 (column 32)
    # Take the results of the 0 card assuming stand-alone
    # Subtract the results of each 1 card (0 + 1 discard) assuming stand-alone
    # Add back the results of each of the 2 cards (0 + 2 discard) assuming stand-alone
    # Subtract the results of each of the 3 cards (0 + 3 discard) assuming stand-alone
    # Add back the results of each of the 4 cards (0 + 4 discard) assuming stand-alone
    # Subtract the results of the 5 cards assuming stand-alone

    drawSmallNoReplace[cardHolds == 32, -1] <- 
        matrix(data=rep(tmpDrawkeep0[, -1], times=sum(cardHolds==32)), 
               nrow=sum(cardHolds==32), byrow=TRUE
               ) -
        tmpDrawkeep1[mtxIndices[cardIndex, 31], -1][cardHolds == 32, ] -
        tmpDrawkeep1[mtxIndices[cardIndex, 30], -1][cardHolds == 32, ] -
        tmpDrawkeep1[mtxIndices[cardIndex, 29], -1][cardHolds == 32, ] -
        tmpDrawkeep1[mtxIndices[cardIndex, 28], -1][cardHolds == 32, ] -
        tmpDrawkeep1[mtxIndices[cardIndex, 27], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 26], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 25], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 24], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 23], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 22], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 21], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 20], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 19], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 18], -1][cardHolds == 32, ] +
        tmpDrawkeep2[mtxIndices[cardIndex, 17], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 16], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 15], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 14], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 13], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 12], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 11], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 10], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 9], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 8], -1][cardHolds == 32, ] -
        tmpDrawkeep3[mtxIndices[cardIndex, 7], -1][cardHolds == 32, ] +
        tmpDrawkeep4[mtxIndices[cardIndex, 6], -1][cardHolds == 32, ] +
        tmpDrawkeep4[mtxIndices[cardIndex, 5], -1][cardHolds == 32, ] +
        tmpDrawkeep4[mtxIndices[cardIndex, 4], -1][cardHolds == 32, ] +
        tmpDrawkeep4[mtxIndices[cardIndex, 3], -1][cardHolds == 32, ] +
        tmpDrawkeep4[mtxIndices[cardIndex, 2], -1][cardHolds == 32, ] -
        tmpDrawkeep5[cardIndex, ][cardHolds == 32, -1]
    

    # evSmallNoReplace[, 32] <- (choose(52, 5) * mean(aScores) - 
    #                           choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 31]] -
    #                           choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 30]] - 
    #                           choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 29]] - 
    #                           choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 28]] - 
    #                           choose(51, 4) * tmpEVkeep1$ev[mtxIndices[cardIndex, 27]] +
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 26]] +
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 25]] + 
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 24]] + 
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 23]] + 
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 22]] + 
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 21]] + 
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 20]] + 
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 19]] + 
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 18]] + 
    #                           choose(50, 3) * tmpEVkeep2$ev[mtxIndices[cardIndex, 17]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 16]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 15]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 14]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 13]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 12]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 11]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 10]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 9]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 8]] -
    #                           choose(49, 2) * tmpEVkeep3$ev[mtxIndices[cardIndex, 7]] +
    #                           choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 6]] +
    #                           choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 5]] +
    #                           choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 4]] +
    #                           choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 3]] +
    #                           choose(48, 1) * tmpEVkeep4$ev[mtxIndices[cardIndex, 2]] -
    #                           evSmallNoReplace[, 1]
    #                       ) / choose(47, 5)

    drawSmallNoReplace
}



# Simulate a specific pay-table given a known sequence of holds
simDrawVar <- function(aT=aType, mtxI=mtxIndices, useHolds,
                       cardI=cardIndex, cardW=cardWeight, startT=startTime, 
                       grTitle="EV Draw Simulation Results", allOut=FALSE
                       ) {
    
    # Get the possible outcomes assuming re-draws are allowed
    keyList <- calcFreq_YesRedraw(mtxIndices=mtxI, aTypes=aT)

    # Next, need to adapt the code for no re-draws
    
    drawSmallNoReplace <- drawNoReplace(cardIndex=cardI, cardHolds=useHolds,
                                        keyList=keyList, mtxIndices=mtxI
                                        )

    if (allOut) {
        return(list(drawSmallNoReplace=drawSmallNoReplace,
                    keyList=keyList
                    )
               )
    } else {
        return(list(drawSmallNoReplace=drawSmallNoReplace
                    )
               )
    }

}

Then, a functions is built to assess the overall mean, variance on the deal, variance on the draw, and distribution of the variances for a given game:

calcMeanVar <- function (tempDraws, hnd2Score, mainName, wgts=cardWeight) {
    drawTemp <- tempDraws$drawSmallNoReplace[, -1]
    cat("\n", "Summary of", mainName,"starting with row sums\n")
    print(table(rowSums(drawTemp)))
    
    drawOdds <- drawTemp / matrix(data=rep(rowSums(drawTemp), ncol(drawTemp)), 
                                  nrow=nrow(drawTemp), byrow=FALSE
                                  )
    print(table(rowSums(drawOdds)))
    
    drawEV <-  drawOdds %*% matrix(data=hnd2Score$val, ncol=1)
    drawEV2 <- drawOdds %*% matrix(data=hnd2Score$val^2, ncol=1)
    
    cat("\n")
    print(paste0(mainName, ": Overall EV and Mean"))
    print(summary(rep(drawEV, times=wgts)))
    print(paste0("Overall Return: ", round(1 + mean(rep(drawEV, times=wgts)), 6)))
    
    cat("\n")
    print(paste0(mainName, ": Variances (Deal, Draw)"))
    print(paste0("Deal Variance: ", round(var(rep(drawEV, times=wgts)), 4)))
    print("Draw Variance Summary Statistics")
    print(summary(rep(drawEV2 - drawEV^2, times=wgts)))
    cat("\n")
    
    hist(log10(1 + rep(drawEV2 - drawEV^2, times=wgts)), col="light blue", 
         main=paste0("Deal Variance for: ", mainName), xlab="1 + log10(Deal Variance)"
         )
}

Games are then simulated for variance, with the outcomes cached for run-time optimization:

# Assess JB 96 game
jb96Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=jb96List$tempSmallMax[2, ],
                        cardI=cardIndex, cardW=cardWeight, startT=startTime, 
                        grTitle="EV Draw Simulation Results", allOut=FALSE
                        )
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
# Assess BP 85 game
bp85Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=bp85List$tempSmallMax[2, ],
                        cardI=cardIndex, cardW=cardWeight, startT=startTime, 
                        grTitle="EV Draw Simulation Results", allOut=FALSE
                        )
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
# Assess BPD 96 game
bpd96Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=bpd96List$tempSmallMax[2, ],
                         cardI=cardIndex, cardW=cardWeight, startT=startTime, 
                         grTitle="EV Draw Simulation Results", allOut=FALSE
                         )
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
# Assess DDB 96 game
ddb96Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=ddb96List$tempSmallMax[2, ],
                         cardI=cardIndex, cardW=cardWeight, startT=startTime, 
                         grTitle="EV Draw Simulation Results", allOut=FALSE
                         )
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
# Assess the TDB 96 game
tdb96Draws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=tdb96List$tempSmallMax[2, ],
                        cardI=cardIndex, cardW=cardWeight, startT=startTime, 
                        grTitle="EV Draw Simulation Results", allOut=FALSE
                        )
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1

And, the function is then applied to each of the games:

calcMeanVar(tempDraws=jb96Draws, hnd2Score=jb96hnd2Score, mainName="JB 96")
## 
##  Summary of JB 96 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2210   18081    9557   82107   18659    3845 
## 
##      1 
## 134459 
## 
## [1] "JB 96: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6426  -0.5175  -0.1763  -0.0046   0.1489 799.0000 
## [1] "Overall Return: 0.995439"
## 
## [1] "JB 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 1.9664"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     2.579     3.549    17.550     4.465 13290.000

calcMeanVar(tempDraws=bp85Draws, hnd2Score=bp85hnd2Score, mainName="BP 85")
## 
##  Summary of BP 85 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2210   18052    9450   81980   18922    3845 
## 
##      1 
## 134459 
## 
## [1] "BP 85: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6434  -0.5183  -0.1865  -0.0083  -0.0426 799.0000 
## [1] "Overall Return: 0.99166"
## 
## [1] "BP 85: Variances (Deal, Draw)"
## [1] "Deal Variance: 2.12"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     2.437     3.392    18.780     5.854 13300.000

calcMeanVar(tempDraws=bpd96Draws, hnd2Score=bpd96hnd2Score, mainName="BPD 96")
## 
##  Summary of BPD 96 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2210   20557    9361   80678   19219    2434 
## 
##      1 
## 134459 
## 
## [1] "BPD 96: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6770  -0.5528  -0.1835  -0.0036   0.1489 799.0000 
## [1] "Overall Return: 0.996417"
## 
## [1] "BPD 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 3.6851"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     4.983    18.150    28.450    19.110 13290.000

calcMeanVar(tempDraws=ddb96Draws, hnd2Score=ddb96hnd2Score, mainName="DDB 96")
## 
##  Summary of DDB 96 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2150   19685    9757   72889   27544    2434 
## 
##      1 
## 134459 
## 
## [1] "DDB 96: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6770  -0.5414  -0.2668  -0.0102   0.1489 799.0000 
## [1] "Overall Return: 0.989808"
## 
## [1] "DDB 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 4.809"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     5.080     8.414    37.180    20.000 13290.000

calcMeanVar(tempDraws=tdb96Draws, hnd2Score=tdb96hnd2Score, mainName="TDB 96")
## 
##  Summary of TDB 96 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2078   21102   14619   70233   24931    1496 
## 
##      1 
## 134459 
## 
## [1] "TDB 96: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6952  -0.5391  -0.3811  -0.0185   0.1489 799.0000 
## [1] "Overall Return: 0.98154"
## 
## [1] "TDB 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 10.6774"
## [1] "Draw Variance Summary Statistics"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##     0.00     4.99     8.00    89.44    50.05 77880.00

The differences in means and variances are evident:

  • JB 96: 99.54% 1.97 + 17.55 = 19.52
  • BP 85: 99.17% 2.12 + 18.78 = 20.90
  • BPD 96: 99.64% 3.69 + 28.45 = 32.14
  • DDB 96: 98.98% 4.81 + 37.18 = 41.99
  • TDB 96: 98.15% 10.68 + 89.44 = 100.12

So, the overall mean (99.544%) and variance on the deal (17.55) for JB 96 match theoretical. Similarly, the overall mean (99.17%) and variance on the deal (18.78) for BP 85 match tehoretical. And, the overall mean (98.15%) for TDB 96 matches theoretical, with an extremely large (89.44) variance on the deal.

All else equal, the variance of TDB 96 is ~5x the variance of JB 96 / BP 85, and with a lower starting return. Further, the “average” variance is itself very spiky, comprised of starting hands that vary as much as ~1000x greater than the average!

Next, the individual means and variances for the starting hands of a given game are explored:

indMeanVar <- function(hnd2Score, listDraws, useName, 
                       cIndex=cardIndex, cWeight=cardWeight, allOut=FALSE
                       ) {

    # Get the vector of outcomes for each starting hand (no longer concerned with all 25)
    possOutcomes <- unique(hnd2Score$val)
    mtxOutcomes <- matrix(data=0L, nrow=length(cIndex), ncol=length(possOutcomes)+2)

    # Probably should have created the unique key in the functions; will want it here, so add it
    mtxOutcomes[, 1] <- cIndex
    mtxOutcomes[, 2] <- cWeight

    cat("\n\nThis will assess the", useName, "means and variances\n\n")
    # Next, work through each possible outcome for the draws
    for (intCtr in seq_along(possOutcomes)) {
        keyCol <- hnd2Score$idx[hnd2Score$val == possOutcomes[intCtr]] + 2
        cat(intCtr, possOutcomes[intCtr], keyCol, "\n")
        mtxOutcomes[, intCtr + 2] <- rowSums(listDraws$drawSmallNoReplace[, keyCol, drop=FALSE])
    }

    # Next, see how many starting hand types there are, considering any starting hands
    # that generate the identical outcomes vector to be indetical for these purposes
    print(nrow(unique(mtxOutcomes[, -(1:2)])))

    # Next, create histograms by the row sums (which is analogous to number of cards held)
    mtxUnique <- unique(mtxOutcomes[, -(1:2)])
    str(mtxUnique)
    data.frame(rSum=rowSums(mtxUnique)) %>% 
        group_by(rSum) %>% 
        summarize(ct=n()) %>%
        print.data.frame()

    # Next, create the mean and variance (of the draw) for each of the unique hands
    # Further, summarize these split by hand type
    myUniqueFrame <- data.frame(rSum=rowSums(mtxUnique), 
                                possSum=mtxUnique %*% possOutcomes,
                                possSum2=mtxUnique %*% possOutcomes^2
                                )

    myUniqueFrame$uqMean <- myUniqueFrame$possSum / myUniqueFrame$rSum
    myUniqueFrame$uqVar <- (myUniqueFrame$possSum2 / myUniqueFrame$rSum) - myUniqueFrame$uqMean^2

    # Send back the unique frame to whoever called the function
    # STILL NEED TO GET THIS TO ADD THE WEIGHTS by Hand Types!!!
    charAll <- apply(mtxOutcomes[, -(1:2)], 1, FUN=paste0, collapse="-")
    charUnique <- apply(mtxUnique, 1, FUN=paste0, collapse="-")
    str(charAll)
    str(charUnique)

    charMatch <- match(charAll, charUnique)
    str(charMatch)
    # print(summary(charMatch))
    
    sumUnique <- tapply(cWeight, charMatch, FUN=sum)
    str(sumUnique)
    # print(summary(sumUnique))
        
    myUniqueCards <- cbind(mtxUnique, sumUnique)
    
    if (!isTRUE(allOut)) {
        list(uqFrame=myUniqueFrame)
    } else {
        list(uqFrame=myUniqueFrame,
             uqCards=myUniqueCards,
             mapOuts=possOutcomes
             )
    }
    
}

Then, the function is run for JB 96, BP 85, BPD 96, DDB 96, and TDB 96, preserving the key counts for all of the relevant unique hands (cached to improve run times):

jb96UniqueList <- indMeanVar(hnd2Score=jb96hnd2Score, listDraws=jb96Draws, 
                             useName="JB 96", allOut=TRUE
                             )
## 
## 
## This will assess the JB 96 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 
## 4 8 5 
## 5 5 6 
## 6 3 7 
## 7 2 8 
## 8 1 9 
## 9 0 10 11 12 13 
## 10 24 16 17 18 19 20 21 22 23 24 25 26 27 
## [1] 1279
##  num [1:1279, 1:10] 0 0 0 0 33 ...
##      rSum  ct
## 1       1   6
## 2      47  34
## 3    1081 105
## 4   16215 104
## 5  178365 155
## 6 1533939 875
##  chr [1:134459] "0-0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-0-1" ...
##  chr [1:1279] "0-0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0-0" ...
##  int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
##  num [1:1279(1d)] 624 3744 54912 123552 96 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1279] "1" "2" "3" "4" ...
bp85UniqueList <- indMeanVar(hnd2Score=bp85hnd2Score, listDraws=bp85Draws, 
                             useName="BP 85", allOut=TRUE
                             )
## 
## 
## This will assess the BP 85 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 
## 4 7 5 
## 5 4 6 
## 6 3 7 
## 7 2 8 
## 8 1 9 
## 9 0 10 11 12 13 
## 10 79 16 17 18 
## 11 39 19 20 21 22 
## 12 24 23 24 25 26 27 
## [1] 1647
##  num [1:1647, 1:12] 0 0 0 0 0 0 0 0 33 0 ...
##      rSum  ct
## 1       1   8
## 2      47  34
## 3    1081 106
## 4   16215  95
## 5  178365 451
## 6 1533939 953
##  chr [1:134459] "0-0-0-0-0-0-0-0-0-1-0-0" ...
##  chr [1:1647] "0-0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-0-0-1-0" ...
##  int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
##  num [1:1647(1d)] 48 144 432 3744 4224 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1647] "1" "2" "3" "4" ...
bpd96UniqueList <- indMeanVar(hnd2Score=bpd96hnd2Score, listDraws=bpd96Draws, 
                              useName="BPD 96", allOut=TRUE
                              )
## 
## 
## This will assess the BPD 96 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 
## 4 8 5 
## 5 5 6 
## 6 3 7 
## 7 2 8 
## 8 0 9 10 11 12 13 
## 9 79 16 17 18 19 20 21 22 23 24 25 26 27 
## [1] 851
##  num [1:851, 1:9] 0 0 0 0 33 ...
##      rSum  ct
## 1       1   6
## 2      47  36
## 3    1081 104
## 4   16215  95
## 5  178365 158
## 6 1533939 452
##  chr [1:134459] "0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-1" ...
##  chr [1:851] "0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0" ...
##  int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
##  num [1:851(1d)] 624 3744 54912 123552 96 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:851] "1" "2" "3" "4" ...
ddb96UniqueList <- indMeanVar(hnd2Score=ddb96hnd2Score, listDraws=ddb96Draws, 
                              useName="DDB 96", allOut=TRUE
                              )
## 
## 
## This will assess the DDB 96 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 23 24 25 26 27 
## 4 8 5 
## 5 5 6 
## 6 3 7 
## 7 2 8 
## 8 0 9 10 11 12 13 
## 9 399 16 
## 10 159 17 18 19 20 
## 11 79 21 22 
## [1] 1260
##  num [1:1260, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##      rSum  ct
## 1       1   7
## 2      47  38
## 3    1081 118
## 4   16215  94
## 5  178365 507
## 6 1533939 496
##  chr [1:134459] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-1-0-0" ...
##  chr [1:1260] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-12-35-0" ...
##  int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
##  num [1:1260(1d)] 12 36 36 108 468 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1260] "1" "2" "3" "4" ...
tdb96UniqueList <- indMeanVar(hnd2Score=tdb96hnd2Score, listDraws=tdb96Draws, 
                              useName="TDB 96", allOut=TRUE
                              )
## 
## 
## This will assess the TDB 96 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 16 
## 3 49 4 23 24 25 26 27 
## 4 8 5 
## 5 5 6 
## 6 3 7 
## 7 1 8 
## 8 0 9 10 11 12 13 
## 9 159 17 18 
## 10 399 19 20 
## 11 79 21 22 
## [1] 945
##  num [1:945, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##      rSum  ct
## 1       1   6
## 2      47  43
## 3    1081 140
## 4   16215  83
## 5  178365 369
## 6 1533939 304
##  chr [1:134459] "0-1-0-0-0-0-0-0-0-0-0" "0-1-0-0-0-0-0-0-0-0-0" ...
##  chr [1:945] "0-1-0-0-0-0-0-0-0-0-0" "0-12-0-0-0-0-0-0-35-0-0" ...
##  int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
##  num [1:945(1d)] 16 36 36 108 468 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:945] "1" "2" "3" "4" ...

With a “flavor” being defined as the full class of starting hands that have an identical payout vector, the following number of flavors are observed per game:

  • JB 96 - 1,279 flavors
  • BP 85 - 1,647 flavors (increase due to different types of quads)
  • BPD 96 - 851 flavors (decrease due to fewer 0-card holds, which tends to be a high-flavor if rare hold)
  • DDB 96 - 1,260 flavors (like BPD 96 but with more flavors of quads)
  • TDB 96 - 945 flavors

  • “Hold 5” flavors by game - JB (6), BP(8), BPD(6), DDB(7), TDB (6)
  • “Hold 4” flavors by game - JB (34), BP(34), BPD(36), DDB(38), TDB (43)
  • “Hold 3” flavors by game - JB (105), BP(106), BPD(104), DDB(118), TDB (140)
  • “Hold 2” flavors by game - JB (104), BP(95), BPD(95), DDB(94), TDB (83)
  • “Hold 1” flavors by game - JB (155), BP(451), BPD(158), DDB(507), TDB (369)
  • “Hold 0” flavors by game - JB (875), BP(953), BPD(452), DDB(496), TDB (304)

While hold 0 is the rarest of the starting hands, it contains the most “flavors” of JB 96 since there are many different “penalties” to straights and flushes that may have been discarded. On the other hand, since TDB 96 will frequently go for long-shots (inside straight draws), there are even fewer flavors of hold 0, but more flavors of hold 4, hold 3, and (especially) hold 1.

Next, a function is created for graphing the various outcomes:

graphMeanVar <- function(useFrame, useName) {
    
    # Hold all 5
    dummy <- useFrame[useFrame$rSum == choose(47, 0), ]
    plot(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="dark green", pch=19, 
         xlab="Log10 of [1+SD] (SQRT of Variance)", ylab="Log 10 of [2+Mean]", 
         main=paste("Outcomes of Starting Flavors for", useName), 
         xlim=c(0, log10(100 * max(ceiling(sqrt(useFrame$uqVar)/100)))), ylim=c(0, 3)
         )

    # Hold 4 of 5
    dummy <- useFrame[useFrame$rSum == choose(47, 1), ]
    points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="light green", pch=19)

    # Hold 3 of 5
    dummy <- useFrame[useFrame$rSum == choose(47, 2), ]
    points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="purple", pch=19)

    # Hold 2 of 5
    dummy <- useFrame[useFrame$rSum == choose(47, 3), ]
    points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="blue", pch=19)

    # Hold 1 of 5
    dummy <- useFrame[useFrame$rSum == choose(47, 4), ]
    points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col="orange", pch=19)

    # Hold 0 of 5
    dummy <- useFrame[useFrame$rSum == choose(47, 5), ]
    points(x=log10(1+sqrt(dummy$uqVar)), y=log10(2+dummy$uqMean), col=rgb(1, 0, 0, 0.25), pch=19)

    legend("top", legend=paste("Hold", 5:0), pch=19, ncol=3,
           col=c("dark green", "light green", "purple", "blue", "orange", "red")
           )

    abline(h=log10(2+c(-1, 0, 2)), lty=2)
    abline(v=log10(1+c(1.5, 4)), lty=2)

}

The function is then run for JB 96, BP 85, BPD 96, DDB 96, and TDB 96:

graphMeanVar(useFrame=jb96UniqueList$uqFrame, useName="JB 96")

graphMeanVar(useFrame=bp85UniqueList$uqFrame, useName="BP 85")

graphMeanVar(useFrame=bpd96UniqueList$uqFrame, useName="BPD 96")

graphMeanVar(useFrame=ddb96UniqueList$uqFrame, useName="DDB 96")

graphMeanVar(useFrame=tdb96UniqueList$uqFrame, useName="TDB 96")

The draws can then be assessed as in several classes for JB 96:

  • High mean, zero variance - all hold 5
  • High-medium mean, very high variance - handful of hold 3/4
  • Medium mean, medium-high variance - handful of hold 2/4
  • Low mean, very high variance - handful of hold 2
  • Low mean, high variance - handful of hold 1/3
  • Low mean, medium variance - handful of hold 2/3/4, and all hold 5
  • Low mean, low variance - handful of hold 1/2

Categorized differently (still for JB 96):

  • Hold 5 - always high mean and zero variance
  • Hold 4 - mean and variance range from low to very high, with mean and variance correlated
  • Hold 3 - generally medium-high variance with medium-low mean
  • Hold 2 - generally medium-high variance with medium-low mean
  • Hold 1 - generally low-medium variance and low mean
  • Hold 0 - low mean, medium variance

Notably, the DDB 96 and TDB 96 games have many higher variance holds, consistent with overall high variance.

Next, pre-processing is run to begin assessing the impact of N-play (1 deal, 1 hold, N iid draws). The impact of N-play can be calculated only once for each “flavor” of hands, then weighted by the likelihood of being dealt that flavor:

assessFlavor <- function(uqList) {

    lastCol <- ncol(uqList$uqCards)
    keyCounts <- uqList$uqCards[, lastCol]

    # Check that means and variances of the draw still make sense
    print(1 + weighted.mean(uqList$uqFrame$uqMean, w=keyCounts))
    print(weighted.mean(uqList$uqFrame$uqVar, w=keyCounts))

    # Report on the number of hands by cards held
    totVar <- sum(uqList$uqFrame$uqVar * keyCounts)
    cbind(uqList$uqFrame, keyCounts) %>%
        group_by(rSum) %>%
        summarize(nFlv=n(), nH=sum(keyCounts), 
                  sumFlv=sum(keyCounts*uqMean),
                  meanFlv=round(sumFlv/nH, 5), 
                  contFlv=round(sumFlv/choose(52, 5), 5),
                  varFMean=round(sum(keyCounts*uqVar)/nH, 1), 
                  varFPct=round(sum(keyCounts*uqVar)/totVar, 3)
                  )
    
}

assessFlavor(uqList=jb96UniqueList)
## [1] 0.995439
## [1] 17.54829
## # A tibble: 6 × 8
##      rSum  nFlv      nH     sumFlv  meanFlv  contFlv varFMean varFPct
##     <dbl> <int>   <dbl>      <dbl>    <dbl>    <dbl>    <dbl>   <dbl>
## 1       1     6   19488  105032.00  5.38957  0.04041      0.0   0.000
## 2      47    34  292176  216684.68  0.74162  0.08337     47.4   0.304
## 3    1081   105  147528  163004.83  1.10491  0.06272    120.6   0.390
## 4   16215   104 1651440 -230169.16 -0.13937 -0.08856      7.3   0.263
## 5  178365   155  403968 -212398.17 -0.52578 -0.08172      4.4   0.039
## 6 1533939   875   84360  -54007.92 -0.64021 -0.02078      2.2   0.004
assessFlavor(uqList=bp85UniqueList)
## [1] 0.9916597
## [1] 18.78406
## # A tibble: 6 × 8
##      rSum  nFlv      nH     sumFlv  meanFlv  contFlv varFMean varFPct
##     <dbl> <int>   <dbl>      <dbl>    <dbl>    <dbl>    <dbl>   <dbl>
## 1       1     8   19488  101136.00  5.18966  0.03891      0.0   0.000
## 2      47    34  292236  188180.68  0.64393  0.07241     46.5   0.278
## 3    1081   106  144876  176284.64  1.21680  0.06783    135.3   0.402
## 4   16215    95 1649040 -218231.79 -0.13234 -0.08397      8.2   0.277
## 5  178365   451  408960 -214931.49 -0.52556 -0.08270      4.7   0.039
## 6 1533939   953   84360  -54114.06 -0.64147 -0.02082      2.4   0.004
assessFlavor(uqList=bpd96UniqueList)
## [1] 0.9964171
## [1] 28.44891
## # A tibble: 6 × 8
##      rSum  nFlv      nH     sumFlv  meanFlv  contFlv varFMean varFPct
##     <dbl> <int>   <dbl>      <dbl>    <dbl>    <dbl>    <dbl>   <dbl>
## 1       1     6   19488  139352.00  7.15066  0.05362      0.0   0.000
## 2      47    36  345240   73465.96  0.21280  0.02827     40.8   0.190
## 3    1081   104  145128  288665.96  1.98904  0.11107    196.4   0.386
## 4   16215    95 1620144 -242281.79 -0.14954 -0.09322     17.7   0.388
## 5  178365   158  416148 -232882.18 -0.55961 -0.08961      5.9   0.033
## 6 1533939   452   52812  -35631.74 -0.67469 -0.01371      3.4   0.002
assessFlavor(uqList=ddb96UniqueList)
## [1] 0.9898078
## [1] 37.17596
## # A tibble: 6 × 8
##      rSum  nFlv      nH     sumFlv  meanFlv  contFlv varFMean varFPct
##     <dbl> <int>   <dbl>      <dbl>    <dbl>    <dbl>    <dbl>   <dbl>
## 1       1     7   19056  119432.00  6.26742  0.04595      0.0   0.000
## 2      47    38  329196   78302.21  0.23786  0.03013     44.1   0.150
## 3    1081   118  152112  277092.73  1.82164  0.10662    235.3   0.370
## 4   16215    94 1443696 -133696.55 -0.09261 -0.05144     26.9   0.402
## 5  178365   507  602088 -331961.20 -0.55135 -0.12773     12.0   0.075
## 6 1533939   496   52812  -35658.22 -0.67519 -0.01372      4.3   0.002
assessFlavor(uqList=tdb96UniqueList)
## [1] 0.98154
## [1] 89.43734
## # A tibble: 6 × 8
##      rSum  nFlv      nH     sumFlv  meanFlv  contFlv varFMean varFPct
##     <dbl> <int>   <dbl>      <dbl>    <dbl>    <dbl>    <dbl>   <dbl>
## 1       1     6   18192  125960.00  6.92392  0.04847      0.0   0.000
## 2      47    43  353088  178522.64  0.50560  0.06869    184.1   0.280
## 3    1081   140  244260  154150.68  0.63109  0.05931    228.1   0.240
## 4   16215    83 1389840 -171163.78 -0.12315 -0.06586     68.0   0.407
## 5  178365   369  557676 -310617.30 -0.55699 -0.11952     30.3   0.073
## 6 1533939   304   35904  -24829.14 -0.69154 -0.00955      8.4   0.001

Next, the total potential outcomes are calculated:

totOutcomes <- function(keyList, useName) {

    # Convert each row so it sums to 5 * choose(47, 5) * cardWeight 
    # (which is in the final column)
    keyFrame <- keyList$uqCards
    mapScore <- keyList$mapOuts
    lastCol <- ncol(keyFrame)

    keySums <- rowSums(keyFrame[, -lastCol])
    keyMult <- 5 * choose(47, 5) / keySums

    useFrame <- keyFrame[, -lastCol]

    for (intCtr in 1:(lastCol-1)) {
        useFrame[, intCtr] <- keyFrame[, intCtr] * keyMult * keyFrame[, lastCol]
    }

    # Get the percentages by outcome
    showTable <- data.frame(scoreType=mapScore, 
                            occPer=sum(useFrame) / colSums(useFrame),
                            contRet=colSums(useFrame) * mapScore / sum(useFrame)
                            )
    showTable$occFreq <- 1/showTable$occPer
    showTable <- showTable[order(-showTable$scoreType), ]

    printShowTable <- showTable
    printShowTable$occPer <- signif(showTable$occPer, 4)
    printShowTable$contRet <- round(showTable$contRet, 6)
    printShowTable$occFreq <- round(showTable$occFreq, 8)
    print(printShowTable)
    
    psEX <- sum(printShowTable$contRet)
    psEX2 <- sum(printShowTable$occFreq * printShowTable$scoreType^2) / sum(printShowTable$occFreq)
    cat("\nPrinted table suggests", useName, "mean return:", 1+psEX, 
        "and overall variance:", psEX2 - psEX^2, "\n\n"
        )

}

totOutcomes(keyList=jb96UniqueList, useName="JB 96")
##    scoreType    occPer   contRet    occFreq
## 2        799 40390.000  0.019782 0.00002476
## 3         49  9148.000  0.005356 0.00010931
## 10        24   423.300  0.056701 0.00236255
## 4          8    86.860  0.092098 0.01151221
## 5          5    90.790  0.055073 0.01101451
## 6          3    89.050  0.033688 0.01122937
## 7          2    13.430  0.148897 0.07444870
## 8          1     7.735  0.129279 0.12927890
## 9          0     4.660  0.000000 0.21458503
## 1         -1     1.833 -0.545435 0.54543467
## 
## Printed table suggests JB 96 mean return: 0.995439 and overall variance: 19.51579
totOutcomes(keyList=bp85UniqueList, useName="BP 85")
##    scoreType    occPer   contRet    occFreq
## 2        799 40230.000  0.019859 0.00002486
## 10        79  5106.000  0.015472 0.00019584
## 3         49  9360.000  0.005235 0.00010684
## 11        39  1897.000  0.020563 0.00052725
## 12        24   609.800  0.039357 0.00163990
## 4          7    86.850  0.080600 0.01151428
## 5          4    91.910  0.043520 0.01088000
## 6          3    89.120  0.033664 0.01122128
## 7          2    13.430  0.148936 0.07446817
## 8          1     7.733  0.129308 0.12930787
## 9          0     4.646  0.000000 0.21525919
## 1         -1     1.835 -0.544855 0.54485452
## 
## Printed table suggests BP 85 mean return: 0.991659 and overall variance: 20.90718
totOutcomes(keyList=bpd96UniqueList, useName="BPD 96")
##   scoreType    occPer   contRet    occFreq
## 2       799 42080.000  0.018989 0.00002377
## 9        79   423.800  0.186417 0.00235970
## 3        49  9173.000  0.005342 0.00010902
## 4         8    87.040  0.091917 0.01148960
## 5         5    89.920  0.055603 0.01112054
## 6         3    78.250  0.038339 0.01277965
## 7         2    13.500  0.148182 0.07409082
## 8         0     2.944  0.000000 0.33965643
## 1        -1     1.824 -0.548370 0.54837048
## 
## Printed table suggests BPD 96 mean return: 0.996419 and overall variance: 32.13652
totOutcomes(keyList=ddb96UniqueList, useName="DDB 96")
##    scoreType    occPer   contRet    occFreq
## 2        799 40800.000  0.019584 0.00002451
## 9        399 16240.000  0.024574 0.00006159
## 10       159  3157.000  0.050367 0.00031678
## 11        79  2601.000  0.030368 0.00038441
## 3         49   574.800  0.085249 0.00173978
## 4          8    92.080  0.086880 0.01086000
## 5          5    88.040  0.056793 0.01135853
## 6          3    78.330  0.038299 0.01276626
## 7          2    13.290  0.150530 0.07526513
## 8          0     2.991  0.000000 0.33438608
## 1         -1     1.809 -0.552837 0.55283693
## 
## Printed table suggests DDB 96 mean return: 0.989807 and overall variance: 41.98492
totOutcomes(keyList=tdb96UniqueList, useName="TDB 96")
##    scoreType    occPer   contRet    occFreq
## 2        799 10460.000  0.076366 0.00009558
## 10       399  5796.000  0.068844 0.00017254
## 9        159  6723.000  0.023649 0.00014874
## 11        79  3126.000  0.025276 0.00031994
## 3         49   581.300  0.084287 0.00172014
## 4          8    95.670  0.083624 0.01045301
## 5          5    78.670  0.063555 0.01271096
## 6          3    73.910  0.040587 0.01352916
## 7          1    13.400  0.074605 0.07460540
## 8          0     3.058  0.000000 0.32699061
## 1         -1     1.788 -0.559254 0.55925391
## 
## Printed table suggests TDB 96 mean return: 0.981539 and overall variance: 100.1161

Next, a function is written to look at N-play (defaulted to 3-play and limited to 1-5 or 10 play):

assessNPlay <- function(keyList, nPlay=3L) {
    
    hnd2Value <- keyList$mapOuts
    uqCol <- ncol(keyList$uqCards)
    cWeight <- keyList$uqCards[, uqCol]
    uqHands <- keyList$uqCards[, -uqCol]
    
    # Only allow nPlay of 1-5 or 10 for now (need to improve algorithm otherwise)
    if (nPlay > 10) {
        print("Cannot have nPlay > 10, will be re-set to 10")
        nPlay <- 10L
        nBase <- 5L  # Run it as a 5-play draw multiplied due to vector sizes/memory
    } else if (nPlay == 10) {
        print("nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed")
        nBase <- 5L  # Run it as a 5-play draw multiplied due to vector sizes/memory
    } else if (nPlay > 5) {
        print("Only nPlay of 1-5 or 10 may be used, will be re-set to 5")
        nPlay <- 5L
        nBase <- 5L  
    } else if (nPlay < 1) {
        print("Cannot have nPlay < 1, will be re-set to 1")
        nPlay <- 1L
        nBase <- 1L
    } else if (!all.equal(as.integer(nPlay), nPlay)) {
        print("nPlay will be coerced to an integer")
        nPlay <- as.integer(nPlay)
        nBase <- nPlay
    } else {
        nBase <- nPlay
    }
    
    mtxNPlay <- matrix(data=0, nrow=(uqCol-1)^nBase, ncol=(2+nBase), 
                       dimnames=list(NULL, c("Value", "Freq", paste0("C", 1:nBase)))
                       )
    
    # Find and store the key positions
    cNum <- vector("list", length=nBase)
    for (intCtr in 1:nBase) {
        cNum[[intCtr]] <- rep(rep(1:(uqCol-1), each=(uqCol-1)^(nBase-intCtr)
                                  ), times=(uqCol-1)^(intCtr-1)
                              )
    }

    str(cNum)
    
    
    # Populate the value of the key positions
    for (intCtr in 1:nBase) {
        mtxNPlay[, (intCtr+2)] <- hnd2Value[cNum[[intCtr]]]
    }
    
    # Populate the overall value of the outcome
    mtxNPlay[, 1] <- rowSums(mtxNPlay[, -(1:2), drop=FALSE])

    # Populate the overall frequencies of the outcome
    uqSums <- rowSums(uqHands)
    mtxFreqs <- uqHands / uqSums[row(uqHands)]
    print(table(rowSums(mtxFreqs)))
    
    cVec <- sapply(cNum, FUN=function(x) { as.vector(x) })
    str(cVec)
    print(head(cVec))

    # See the number of unique outcomes
    cat("\n\nNumber of unique outcome types:", length(table(mtxNPlay[, 1])), "\n")

    # Calculate the possible ways to get a particular outcome
    dfOutcome <- data.frame(nOutcome=mtxNPlay[, 1]) %>% 
        group_by(nOutcome) %>% summarize(ct=n())
    dfOutcome$wts <- 0
    vecRow <- as.vector(row(mtxNPlay[, 1, drop=FALSE]))
    mtxNFirst <- mtxNPlay[, 1, drop=TRUE]
    keyOutcome <- dfOutcome$nOutcome
    
    # Create all the 2-column multiplications
    mtxFreq_2x2 <- matrix(data=NA, nrow=nrow(mtxFreqs), ncol=ncol(mtxFreqs)^2)
    grid_2x2 <- expand.grid(1:ncol(mtxFreqs), 1:ncol(mtxFreqs))
    for (intCtr in 1:nrow(grid_2x2)) {
        c1 <- grid_2x2[intCtr, 1]
        c2 <- grid_2x2[intCtr, 2]
        
        mtxFreq_2x2[, intCtr] <- mtxFreqs[, c1] * mtxFreqs[, c2]
    }
    
    # Create all the 3-column multiplications
    mtxFreq_3x3 <- matrix(data=NA, nrow=nrow(mtxFreqs), ncol=ncol(mtxFreqs)^3)
    grid_3x3 <- expand.grid(1:ncol(mtxFreqs), 1:ncol(mtxFreqs), 1:ncol(mtxFreqs))
    for (intCtr in 1:nrow(grid_3x3)) {
        c1 <- grid_3x3[intCtr, 1]
        c2 <- grid_3x3[intCtr, 2]
        c3 <- grid_3x3[intCtr, 3]
        
        mtxFreq_3x3[, intCtr] <- mtxFreqs[, c1] * mtxFreqs[, c2] * mtxFreqs[, c3]
    }
    
    
    cat("\nMoving to assess the:", nrow(dfOutcome), "rows of outcomes\n")
    
    # Use a work-around specific to 5/10-play (expand and generalize the logic later)
    if (nPlay %in% c(5, 10)) {
        
        storeOutcomes <- matrix(data=NA, nrow=nrow(mtxFreqs), ncol=length(dfOutcome$nOutcome))
        
        for (intCtr in 1:nrow(dfOutcome)) {
            # Find the key outcome
            keyOut <- keyOutcome[intCtr]
        
            # Get the row numbers of cVec that will be associated to the key outcome
            keyRow <- vecRow[mtxNFirst == keyOut]
        
            # Convert these row numbers to the relevant 3x3 and 2x2 lookups
            ncKey <- ncol(mtxFreqs)
            keyMtx <- cVec[keyRow, , drop=FALSE]
            col_3x3 <- 1 + (keyMtx[, 1] - 1 + ncKey * (keyMtx[, 2] - 1) + ncKey^2 * (keyMtx[, 3] - 1))
            col_2x2 <- 1 + (keyMtx[, 4] - 1 + ncKey * (keyMtx[, 5] - 1))
            
            # Use the lookups to get the key values
            mtxApply <- 
                mtxFreq_3x3[, col_3x3, drop=FALSE] * mtxFreq_2x2[, col_2x2, drop=FALSE]
            
            if (intCtr %% 100 == 0) {
                str(mtxApply)
                str(rowSums(mtxApply))
                print(intCtr)
            }
        
            dfOutcome$wts[intCtr] <- dfOutcome$wts[intCtr] + sum(cWeight * rowSums(mtxApply))
            storeOutcomes[, intCtr] <- rowSums(mtxApply)    
        }
        
    } else {
        
        storeOutcomes <- NULL  # Not needed for these hands (nPlay of 1-4)
        
        for (intCtr in 1:nrow(dfOutcome)) {
        
            # Find the key outcome
            keyOut <- keyOutcome[intCtr]
        
            # Get the row numbers of cVec that will be associated to the key outcome
            keyRow <- vecRow[mtxNFirst == keyOut]
        
            mtxKey <- array(data=mtxFreqs[, t(cVec[keyRow, , drop=FALSE]), drop=FALSE], 
                            dim=c(nrow(mtxFreqs), nPlay, length(keyRow))
                            )
    
            mtxApply <- apply(mtxKey, c(1, 3), FUN=prod)
        
            if (intCtr %% 100 == 0) {
                str(mtxKey)
                str(mtxApply)
                str(rowSums(mtxApply))
                print(intCtr)
            }
        
            dfOutcome$wts[intCtr] <- dfOutcome$wts[intCtr] + sum(cWeight * rowSums(mtxApply))
            
        }
    
    }
    
    if (nPlay %in% c(1, 2, 3, 4, 5)) {
        
        # Mean expressed on a percentage basis
        # keyMean <- sum(mtxNPlay[, 2] * mtxNPlay[, 1]) / sum(mtxNPlay[, 2])
        keyMean <- sum(dfOutcome$wts * dfOutcome$nOutcome) / sum(dfOutcome$wts)
        cat("\n\nMean:", 1 + keyMean/nPlay)  # To move this back to a "per full bet" basis

        # Variance expressed as the overall variance per "base unit"
        # keyVar <- sum(mtxNPlay[, 2] * mtxNPlay[, 1]^2) / sum(mtxNPlay[, 2]) - keyMean^2
        keyVar <- sum(dfOutcome$wts * dfOutcome$nOutcome^2) / sum(dfOutcome$wts) - keyMean^2
        cat("\t\tVariance:", keyVar, "\n")  # Leave this "as is"; it is the full variance amount
        
        out10Play <- NULL
        
    } else if (nPlay %in% c(10)) {
        
        # Matrix multiply the key starting outcome hands
        mtxOutcomeProbs <- t(storeOutcomes * cWeight) %*% storeOutcomes
        mtxOutcomeValues <- dfOutcome$nOutcome[row(mtxOutcomeProbs)] +
            dfOutcome$nOutcome[col(mtxOutcomeProbs)]
        
        # Make the out10Play frame using dplyr
        out10Play <- data.frame(nOutcome=mtxOutcomeValues, 
                                s_wts=as.vector(mtxOutcomeProbs)
                                ) %>%
            group_by(nOutcome) %>%
            summarize(wts=sum(s_wts))
        
        # Find the potential results (perhaps matricize . . .)
        # out10Play <- data.frame(nOutcome=sort(unique(grid10$sumRes)), wts=0)
        # for (intCtr in 1:nrow(grid10)) {
        #     keyVal <- storeOutcomes[, grid10$Var1[intCtr]] * storeOutcomes[, grid10$Var2[intCtr]]
        #     out10Spot <- which(out10Play$nOutcome == grid10$sumRes[intCtr])
        #     out10Play$wts[out10Spot] <- out10Play$wts[out10Spot] + sum(cWeight * keyVal)
        # }
        
        
        # Report back on the mean and the variance

        # Mean expressed on a percentage basis
        keyMean <- sum(out10Play$wts * out10Play$nOutcome) / sum(out10Play$wts)
        cat("\n\nMean:", 1 + keyMean/nPlay)  # To move this back to a "per full bet" basis

        # Variance expressed as the overall variance per "base unit"
        keyVar <- sum(out10Play$wts * out10Play$nOutcome^2) / sum(out10Play$wts) - keyMean^2
        cat("\t\tVariance:", keyVar, "\n")  # Leave this "as is"; it is the full variance amount
        
        # Convert back to a pure data frame
        out10Play <- as.data.frame(out10Play)
        
    }
    
    list(dfOutcome=dfOutcome, mtxNPlay=mtxNPlay, 
         storeOutcomes=storeOutcomes, out10Play=out10Play
         )
    
}

The actual runs are cached since multiple methodologies are tested later and this portion is no longer being modified:

# Run as 1/3/5-play for JB 96, BP 85, BPD 96, DDB 96, and TDB 96
jb96_1Play <- assessNPlay(keyList=jb96UniqueList, nPlay=1L)
## List of 1
##  $ : int [1:10] 1 2 3 4 5 6 7 8 9 10
## 
##    1 
## 1279 
##  int [1:10, 1] 1 2 3 4 5 6 7 8 9 10
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 10 
## 
## Moving to assess the: 10 rows of outcomes
## 
## 
## Mean: 0.995439       Variance: 19.51468
jb96_3Play <- assessNPlay(keyList=jb96UniqueList, nPlay=3L)
## List of 3
##  $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1279 
##  int [1:1000, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 114 
## 
## Moving to assess the: 114 rows of outcomes
##  num [1:1279, 1:3, 1:6] 0 0 0 0 0 ...
##  num [1:1279, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## 
## 
## Mean: 0.995439       Variance: 70.34236
jb96_5Play <- assessNPlay(keyList=jb96UniqueList, nPlay=5L)
## List of 5
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1279 
##  int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 406 
## 
## Moving to assess the: 406 rows of outcomes
##  num [1:1279, 1:45] 0 0 0 0 0.000157 ...
##  num [1:1279] 0 0 0 0 0.00157 ...
## [1] 100
##  num [1:1279, 1:280] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1279, 1:240] 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 ...
## [1] 300
##  num [1:1279, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## 
## 
## Mean: 0.995439       Variance: 136.9012
bp85_1Play <- assessNPlay(keyList=bp85UniqueList, nPlay=1L)
## List of 1
##  $ : int [1:12] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:12, 1] 1 2 3 4 5 6 7 8 9 10 ...
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 12 
## 
## Moving to assess the: 12 rows of outcomes
## 
## 
## Mean: 0.9916597      Variance: 20.90408
bp85_3Play <- assessNPlay(keyList=bp85UniqueList, nPlay=3L)
## List of 3
##  $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1728] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:1728, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 198 
## 
## Moving to assess the: 198 rows of outcomes
##  num [1:1647, 1:3, 1:9] 0 0 0 0 0 ...
##  num [1:1647, 1:9] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## 
## 
## Mean: 0.9916597      Variance: 75.4324
bp85_5Play <- assessNPlay(keyList=bp85UniqueList, nPlay=5L)
## List of 5
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 722 
## 
## Moving to assess the: 722 rows of outcomes
##  num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 ...
## [1] 100
##  num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:1647, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1647, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## 
## 
## Mean: 0.9916597      Variance: 146.9209
bpd96_1Play <- assessNPlay(keyList=bpd96UniqueList, nPlay=1L)
## List of 1
##  $ : int [1:9] 1 2 3 4 5 6 7 8 9
## 
##   1 
## 851 
##  int [1:9, 1] 1 2 3 4 5 6 7 8 9
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 9 
## 
## Moving to assess the: 9 rows of outcomes
## 
## 
## Mean: 0.9964171      Variance: 32.13404
bpd96_3Play <- assessNPlay(keyList=bpd96UniqueList, nPlay=3L)
## List of 3
##  $ : int [1:729] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:729] 1 1 1 1 1 1 1 1 1 2 ...
##  $ : int [1:729] 1 2 3 4 5 6 7 8 9 1 ...
## 
##   1 
## 851 
##  int [1:729, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 115 
## 
## Moving to assess the: 115 rows of outcomes
##  num [1:851, 1:3, 1:6] 0 0 0 0 0 ...
##  num [1:851, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## 
## 
## Mean: 0.9964171      Variance: 118.5129
bpd96_5Play <- assessNPlay(keyList=bpd96UniqueList, nPlay=5L)
## List of 5
##  $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:59049] 1 1 1 1 1 1 1 1 1 2 ...
##  $ : int [1:59049] 1 2 3 4 5 6 7 8 9 1 ...
## 
##   1 
## 851 
##  int [1:59049, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 511 
## 
## Moving to assess the: 511 rows of outcomes
##  num [1:851, 1:200] 0.00 0.00 0.00 0.00 1.29e-06 ...
##  num [1:851] 0.0 0.0 0.0 0.0 4.3e-05 ...
## [1] 100
##  num [1:851, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:851, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:851, 1:40] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:851] 0 0 0 0 0 ...
## [1] 400
##  num [1:851, 1:10] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## 
## 
## Mean: 0.9964171      Variance: 234.3727
ddb96_1Play <- assessNPlay(keyList=ddb96UniqueList, nPlay=1L)
## List of 1
##  $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1260 
##  int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 11 
## 
## Moving to assess the: 11 rows of outcomes
## 
## 
## Mean: 0.9898078      Variance: 41.98498
ddb96_3Play <- assessNPlay(keyList=ddb96UniqueList, nPlay=3L)
## List of 3
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1260 
##  int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 200 
## 
## Moving to assess the: 200 rows of outcomes
##  num [1:1260, 1:3, 1:3] 0 0 0 0 0 ...
##  num [1:1260, 1:3] 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 ...
## [1] 100
##  num [1:1260, 1:3, 1] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260, 1] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## 
## 
## Mean: 0.9898078      Variance: 154.8091
ddb96_5Play <- assessNPlay(keyList=ddb96UniqueList, nPlay=5L)
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1260 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1041 
## 
## Moving to assess the: 1041 rows of outcomes
##  num [1:1260, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1260, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1260, 1:10] 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 ...
## [1] 300
##  num [1:1260, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1260, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1260, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:1260, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
##  num [1:1260, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.9898078      Variance: 306.1054
tdb96_1Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=1L)
## List of 1
##  $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
## 
##   1 
## 945 
##  int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 11 
## 
## Moving to assess the: 11 rows of outcomes
## 
## 
## Mean: 0.98154        Variance: 100.1148
tdb96_3Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=3L)
## List of 3
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
## 
##   1 
## 945 
##  int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 206 
## 
## Moving to assess the: 206 rows of outcomes
##  num [1:945, 1:3, 1:3] 0 0 0 0 1 0 0 0 0 0 ...
##  num [1:945, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:945, 1:3, 1:3] 1 0.255 0 0 0 ...
##  num [1:945, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## 
## 
## Mean: 0.98154        Variance: 364.4089
tdb96_5Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=5L)
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##   1 
## 945 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1064 
## 
## Moving to assess the: 1064 rows of outcomes
##  num [1:945, 1:220] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:945, 1:390] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 ...
## [1] 400
##  num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:945, 1:290] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 ...
## [1] 600
##  num [1:945, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:945, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:945, 1:115] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0.0158 0 ...
## [1] 900
##  num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.98154        Variance: 714.1226

The 10-play variant no longer needs to be cached since the vectorized solution for driving 5-play to 10-play runs extremely quickly (later reverted to caching for the same reason as the above):

# Run as 10-play for JB 96, BP 85, BPD 96, DDB 96, and TDB 96
jb96_10Play <- assessNPlay(keyList=jb96UniqueList, nPlay=10L)
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1279 
##  int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 406 
## 
## Moving to assess the: 406 rows of outcomes
##  num [1:1279, 1:45] 0 0 0 0 0.000157 ...
##  num [1:1279] 0 0 0 0 0.00157 ...
## [1] 100
##  num [1:1279, 1:280] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1279, 1:240] 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 ...
## [1] 300
##  num [1:1279, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## 
## 
## Mean: 0.995439       Variance: 372.1217
bp85_10Play <- assessNPlay(keyList=bp85UniqueList, nPlay=10L)
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 722 
## 
## Moving to assess the: 722 rows of outcomes
##  num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 ...
## [1] 100
##  num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:1647, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1647, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## 
## 
## Mean: 0.9916597      Variance: 399.8432
bpd96_10Play <- assessNPlay(keyList=bpd96UniqueList, nPlay=10L)
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:59049] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:59049] 1 1 1 1 1 1 1 1 1 2 ...
##  $ : int [1:59049] 1 2 3 4 5 6 7 8 9 1 ...
## 
##   1 
## 851 
##  int [1:59049, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 511 
## 
## Moving to assess the: 511 rows of outcomes
##  num [1:851, 1:200] 0.00 0.00 0.00 0.00 1.29e-06 ...
##  num [1:851] 0.0 0.0 0.0 0.0 4.3e-05 ...
## [1] 100
##  num [1:851, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:851, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:851, 1:40] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:851] 0 0 0 0 0 ...
## [1] 400
##  num [1:851, 1:10] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:851] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
## 
## 
## Mean: 0.9964171      Variance: 653.0019
ddb96_10Play <- assessNPlay(keyList=ddb96UniqueList, nPlay=10L)
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1260 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1041 
## 
## Moving to assess the: 1041 rows of outcomes
##  num [1:1260, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1260, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1260, 1:10] 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 ...
## [1] 300
##  num [1:1260, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1260, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1260, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:1260, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
##  num [1:1260, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.9898078      Variance: 852.662
tdb96_10Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=10L)
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##   1 
## 945 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1064 
## 
## Moving to assess the: 1064 rows of outcomes
##  num [1:945, 1:220] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:945, 1:390] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 ...
## [1] 400
##  num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:945, 1:290] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 ...
## [1] 600
##  num [1:945, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:945, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:945, 1:115] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0.0158 0 ...
## [1] 900
##  num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.98154        Variance: 1962.117

Next, 2,000 simulations are run for up to 16,000 hands, with the percentiles assessed:

sim_NPlay <- function(keyFrame, useName, nPlay, nHands, nSims, 
                      genCumMin=FALSE, genFullMin=FALSE, smpFullMin=100, runSTP=FALSE
                      ) {
    
    # Extract outcomes and associated odds from the N-play list
    oddsNPlay <- round(100 * keyFrame$wts, 0)
    resNPlay <- keyFrame$nOutcome
    
    # Validate that the rouding of odds has not adversely impacted mean/variance
    meanNPlay <- sum(oddsNPlay * resNPlay) / sum(oddsNPlay)
    varNPlay <- sum(oddsNPlay * resNPlay^2) / sum(oddsNPlay) - meanNPlay^2
    cat("\nMean base return per hand:", 1+meanNPlay/nPlay, "with total variance:", varNPlay)
    
    # Take an appropriately sized sample from the resNPlay
    holdNPlay <- base::sample(rep(resNPlay, times=oddsNPlay), 
                              nSims*nHands, replace=TRUE
                              )
    
    # Make the STP data (if appropriate)
    if (isTRUE(runSTP)) {
        vecSTP <- c(rep(1, 1400), rep(2, 17), rep(3, 33), rep(4, 16), 
                    rep(5, 24), rep(8, 6), rep(10, 4)
                    )
        multSTP <- base::sample(vecSTP, nSims*nHands, replace=TRUE)
        
        # Apply the appropriate multiplier (applies only to winners, not bets)
        holdNPlay <- (holdNPlay + nPlay) * multSTP - nPlay
        
        # Subtract the extra bets (costs .2 per hand over nPlay total)
        holdNPlay <- holdNPlay - .2 * nPlay
    }
    
    # Convert to the overall outcomes (each column is a simulation)
    sumsNPlay <- colSums(matrix(holdNPlay, ncol=nSims))
    if (isTRUE(genCumMin) | isTRUE(genFullMin)) {
        cumSumNPlay <- apply(matrix(holdNPlay, ncol=nSims), 2, FUN=cumsum)
        if (isTRUE(genCumMin)) { cumminNPlay <- apply(cumSumNPlay , 2, FUN=min) }
        if (isTRUE(genFullMin)) { 
            fullminNPlay <- apply(cumSumNPlay, 2, FUN=cummin)
            rownames(fullminNPlay) <- 1:nrow(fullminNPlay)
            smlminNPlay <- fullminNPlay[seq(smpFullMin, nrow(fullminNPlay), by=smpFullMin), ]
        }
    }
    
    # Report on the overall mean and variance/standard deviation
    meanOverall <- mean(sumsNPlay) / (nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )
    varOverall <- var(sumsNPlay)
    sdOverall <- sd(sumsNPlay)
    cat("\nMean return per hand:", 
        paste0(round(100 * (1 + meanOverall/nPlay), 3), "%"), 
        "with total variance (sd as % of total bet):", 
        prettyNum(round(varOverall, 0), big.mark=","), "(", 
        paste0(round(100*sdOverall/(nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )/nPlay, 2), "%"), 
        ")\n"
        )
    print(round(quantile(sumsNPlay/(nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )/nPlay, 
                         c(0.01, 0.05, 0.10, 0.25, 0.5, 0.75, 0.90, 0.95, 0.99)
                         )
                , 4)
          )
    
    # Report on the percentage distributions
    par(mfrow=c(1, 2))
    hist(sumsNPlay/(nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )/nPlay, col="light blue", 
         main=paste0("% Ret: ", nPlay, "-play (", nHands, " ", useName," deals)"), xlab="% Return"
         )
    plot(x=(1:nSims)/nSims, 
         y=sort(sumsNPlay/(nHands * if(isTRUE(runSTP)) { 1.2 } else { 1.0 } )/nPlay), 
         pch=19, col="navy blue", 
         main=paste0("% Ret: ", nPlay, "-play (", nHands, " ", useName," deals)"), 
         xlab="Percentile", ylab="% Returns"
         )
    abline(h=0, v=0.5, lty=2)
    par(mfrow=c(1, 1))

    if (isTRUE(genCumMin) & isTRUE(genFullMin)) {
        list(sumsNPlay=sumsNPlay, cumminNPlay=cumminNPlay, fullminNPlay=smlminNPlay)
    } else if (isTRUE(genCumMin) & !isTRUE(genFullMin)) {
        list(sumsNPlay=sumsNPlay, cumminNPlay=cumminNPlay)
    } else if (!isTRUE(genCumMin) & isTRUE(genFullMin)) {
        list(sumsNPlay=sumsNPlay, fullminNPlay=smlminNPlay)
    } else {
        sumsNPlay
    }
    
}

The simulations run reasonably quickly individually, but take enough time in aggregate to merit caching:

# Run for 10/5-play with 2,000 simulations of 16,000 hands
set.seed(1612200748)
jb96_10Sim <- sim_NPlay(keyFrame=jb96_10Play$out10Play, useName="JB 96", 
                        nPlay=10, nHands=16000, nSim=2000
                        )
## 
## Mean return per hand: 0.9954273 with total variance: 371.8727
## Mean return per hand: 99.616% with total variance (sd as % of total bet): 6,032,571 ( 1.54% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0322 -0.0251 -0.0212 -0.0140 -0.0058  0.0044  0.0146  0.0222  0.0477

set.seed(1612210738)
jb96_5Sim <- sim_NPlay(keyFrame=jb96_5Play$dfOutcome, useName="JB 96", 
                       nPlay=5, nHands=16000, nSim=2000
                       )
## 
## Mean return per hand: 0.9954371 with total variance: 136.8871
## Mean return per hand: 99.563% with total variance (sd as % of total bet): 2,319,842 ( 1.9% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0392 -0.0310 -0.0257 -0.0177 -0.0065  0.0056  0.0200  0.0306  0.0542

set.seed(1612201348)
bp85_10Sim <- sim_NPlay(keyFrame=bp85_10Play$out10Play, useName="BP 85", 
                        nPlay=10, nHands=16000, nSim=2000
                        )
## 
## Mean return per hand: 0.9916439 with total variance: 399.5
## Mean return per hand: 99.174% with total variance (sd as % of total bet): 6,170,846 ( 1.55% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0364 -0.0303 -0.0263 -0.0186 -0.0096 -0.0001  0.0106  0.0188  0.0454

set.seed(1612211338)
bp85_5Sim <- sim_NPlay(keyFrame=bp85_5Play$dfOutcome, useName="BP 85", 
                       nPlay=5, nHands=16000, nSim=2000
                       )
## 
## Mean return per hand: 0.9916568 with total variance: 146.9033
## Mean return per hand: 99.13% with total variance (sd as % of total bet): 2,500,141 ( 1.98% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0447 -0.0359 -0.0311 -0.0228 -0.0108  0.0023  0.0174  0.0269  0.0479

set.seed(2016122008)
bpd96_10Sim <- sim_NPlay(keyFrame=bpd96_10Play$out10Play, useName="BPD 96", 
                         nPlay=10, nHands=16000, nSim=2000
                         )
## 
## Mean return per hand: 0.996406 with total variance: 652.7752
## Mean return per hand: 99.563% with total variance (sd as % of total bet): 10,255,554 ( 2% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0477 -0.0361 -0.0291 -0.0175 -0.0054  0.0080  0.0203  0.0292  0.0498

set.seed(2016122108)
bpd96_5Sim <- sim_NPlay(keyFrame=bpd96_5Play$dfOutcome, useName="BPD 96", 
                        nPlay=5, nHands=16000, nSim=2000
                        )
## 
## Mean return per hand: 0.9964151 with total variance: 234.3575
## Mean return per hand: 99.652% with total variance (sd as % of total bet): 3,584,023 ( 2.37% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0517 -0.0405 -0.0327 -0.0203 -0.0045  0.0116  0.0272  0.0374  0.0593

set.seed(1220160749)
ddb96_10Sim <- sim_NPlay(keyFrame=ddb96_10Play$out10Play, useName="DDB 96", 
                         nPlay=10, nHands=16000, nSim=2000
                         )
## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.896% with total variance (sd as % of total bet): 12,411,898 ( 2.2% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0578 -0.0449 -0.0382 -0.0269 -0.0116  0.0031  0.0173  0.0272  0.0446

set.seed(1221160739)
ddb96_5Sim <- sim_NPlay(keyFrame=ddb96_5Play$dfOutcome, useName="DDB 96", 
                        nPlay=5, nHands=16000, nSim=2000
                        )
## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.942% with total variance (sd as % of total bet): 4,671,484 ( 2.7% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0655 -0.0523 -0.0443 -0.0294 -0.0123  0.0069  0.0243  0.0352  0.0626

set.seed(1220201608)
tdb96_10Sim <- sim_NPlay(keyFrame=tdb96_10Play$out10Play, useName="TDB 96", 
                         nPlay=10, nHands=16000, nSim=2000
                         )
## 
## Mean return per hand: 0.9815219 with total variance: 1961.747
## Mean return per hand: 98.154% with total variance (sd as % of total bet): 31,748,125 ( 3.52% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0905 -0.0723 -0.0619 -0.0427 -0.0207  0.0031  0.0276  0.0436  0.0792

set.seed(1221201608)
tdb96_5Sim <- sim_NPlay(keyFrame=tdb96_5Play$dfOutcome, useName="TDB 96", 
                        nPlay=5, nHands=16000, nSim=2000
                        )
## 
## Mean return per hand: 0.9815355 with total variance: 714.0964
## Mean return per hand: 98.241% with total variance (sd as % of total bet): 11,199,067 ( 4.18% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1028 -0.0822 -0.0686 -0.0472 -0.0208  0.0097  0.0362  0.0547  0.0883

A second attempt is made to further vectorize the n-play process, with results compared to the previous results:

# Function to create the 1-play data
get_uq1Play <- function(keyList) {

    # Get the basic parameters
    uq_1PlayRes <- keyList$mapOuts
    uqCol <- ncol(keyList$uqCards)
    cWeight <- keyList$uqCards[, uqCol]
    uqHands <- keyList$uqCards[, -uqCol]

    # Convert uqHands to percentage outcomes by hand
    uq_1Play <- diag(1/rowSums(uqHands)) %*% uqHands
    str(uq_1Play)
    table(rowSums(uq_1Play))
    
    list(uq_Play=uq_1Play, uq_Res=uq_1PlayRes, cWeight=cWeight)
    
}


# Get the 1-play data for JB 96, BP 85, and TDB 96
startTime <- proc.time()

jb96_uq001 <- get_uq1Play(keyList=jb96UniqueList)
##  num [1:1279, 1:10] 0 0 0 0 0.702 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:10] "" "" "" "" ...
str(jb96_uq001)
## List of 3
##  $ uq_Play: num [1:1279, 1:10] 0 0 0 0 0.702 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:10] "" "" "" "" ...
##  $ uq_Res : num [1:10] -1 799 49 8 5 3 2 1 0 24
##  $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
##   ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...
bp85_uq001 <- get_uq1Play(keyList=bp85UniqueList)
##  num [1:1647, 1:12] 0 0 0 0 0 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:12] "" "" "" "" ...
str(bp85_uq001)
## List of 3
##  $ uq_Play: num [1:1647, 1:12] 0 0 0 0 0 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:12] "" "" "" "" ...
##  $ uq_Res : num [1:12] -1 799 49 7 4 3 2 1 0 79 ...
##  $ cWeight: Named num [1:1647] 48 144 432 3744 4224 ...
##   ..- attr(*, "names")= chr [1:1647] "1" "2" "3" "4" ...
tdb96_uq001 <- get_uq1Play(keyList=tdb96UniqueList)
##  num [1:945, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:11] "" "" "" "" ...
str(tdb96_uq001)
## List of 3
##  $ uq_Play: num [1:945, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : NULL
##   .. ..$ : chr [1:11] "" "" "" "" ...
##  $ uq_Res : num [1:11] -1 799 49 8 5 3 1 0 159 399 ...
##  $ cWeight: Named num [1:945] 16 36 36 108 468 ...
##   ..- attr(*, "names")= chr [1:945] "1" "2" "3" "4" ...
proc.time() - startTime
##    user  system elapsed 
##    0.07    0.02    0.09
# Function to cross-product n-play and m-play
create_mnPlay <- function(keyN, keyM) {
    
    aTest <- matrix(data=0, nrow=nrow(keyN$uq_Play), 
                    ncol=ncol(keyM$uq_Play)*ncol(keyN$uq_Play)
                    )
    
    # Matrix multiply by "flavor" (unique rows)
    for (intCtr in 1:nrow(keyN$uq_Play)) {
        aTest[intCtr, ] <- as.vector( outer( keyN$uq_Play[intCtr, ], keyM$uq_Play[intCtr, ] ) )
    }
 
    # Sum outcomes for matrix cross product (column values for aTest)
    aScore <- as.vector(outer(keyN$uq_Res, keyM$uq_Res, FUN="+"))
    
    # Find and sort the unique scores
    uqRes <- sort(unique(aScore))

    # Convert the full aTest in to unique hands with values by column
    map_Play <- matrix(data=0L, nrow=ncol(aTest), ncol=length(uqRes))
    map_Mtx <- matrix(data=c(1:length(aScore), match(aScore, uqRes)), 
                      nrow=length(aScore)
                      ) 
    map_Play[ map_Mtx ] <- 1L
    uq_Play <- aTest %*% map_Play
    
    list(uq_Play=uq_Play, uq_Res=uqRes, cWeight=keyN$cWeight)
        
}


# Take JB 96, BP 85, and TDB 96 and expand from 1-play to 2-5 play
startTime <- proc.time()

jb96_uq002 <- create_mnPlay(keyN=jb96_uq001, keyM=jb96_uq001)
jb96_uq003 <- create_mnPlay(keyN=jb96_uq002, keyM=jb96_uq001)
jb96_uq004 <- create_mnPlay(keyN=jb96_uq003, keyM=jb96_uq001)
jb96_uq005 <- create_mnPlay(keyN=jb96_uq004, keyM=jb96_uq001)

proc.time() - startTime
##    user  system elapsed 
##    1.58    0.00    1.57
bp85_uq002 <- create_mnPlay(keyN=bp85_uq001, keyM=bp85_uq001)
bp85_uq003 <- create_mnPlay(keyN=bp85_uq002, keyM=bp85_uq001)
bp85_uq004 <- create_mnPlay(keyN=bp85_uq003, keyM=bp85_uq001)
bp85_uq005 <- create_mnPlay(keyN=bp85_uq004, keyM=bp85_uq001)

proc.time() - startTime
##    user  system elapsed 
##    8.67    0.02    8.74
tdb96_uq002 <- create_mnPlay(keyN=tdb96_uq001, keyM=tdb96_uq001)
tdb96_uq003 <- create_mnPlay(keyN=tdb96_uq002, keyM=tdb96_uq001)
tdb96_uq004 <- create_mnPlay(keyN=tdb96_uq003, keyM=tdb96_uq001)
tdb96_uq005 <- create_mnPlay(keyN=tdb96_uq004, keyM=tdb96_uq001)

proc.time() - startTime
##    user  system elapsed 
##   14.52    0.06   14.68

The comparisons to former algorithms are cached to improve run times:

# Compare with the former algorithm (JB 96)
new_2dfOutcome <- data.frame(nOutcome=jb96_uq002$uq_Res, 
                             wts=colSums(diag(jb96_uq002$cWeight) %*% jb96_uq002$uq_Play)
                             )
new_5dfOutcome <- data.frame(nOutcome=jb96_uq005$uq_Res, 
                             wts=colSums(diag(jb96_uq005$cWeight) %*% jb96_uq005$uq_Play)
                             )

jb96_2Play <- assessNPlay(keyList=jb96UniqueList, nPlay=2L)
## List of 2
##  $ : int [1:100] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1279 
##  int [1:100, 1:2] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2]
## [1,]    1    1
## [2,]    1    2
## [3,]    1    3
## [4,]    1    4
## [5,]    1    5
## [6,]    1    6
## 
## 
## Number of unique outcome types: 42 
## 
## Moving to assess the: 42 rows of outcomes
## 
## 
## Mean: 0.995439       Variance: 42.96213
jb96_5Play <- assessNPlay(keyList=jb96UniqueList, nPlay=5L)
## List of 5
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1279 
##  int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 406 
## 
## Moving to assess the: 406 rows of outcomes
##  num [1:1279, 1:45] 0 0 0 0 0.000157 ...
##  num [1:1279] 0 0 0 0 0.00157 ...
## [1] 100
##  num [1:1279, 1:280] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1279, 1:240] 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 ...
## [1] 300
##  num [1:1279, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1279] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## 
## 
## Mean: 0.995439       Variance: 136.9012
all.equal(as.data.frame(jb96_2Play$dfOutcome[, -2]), new_2dfOutcome)
## [1] TRUE
all.equal(as.data.frame(jb96_5Play$dfOutcome[, -2]), new_5dfOutcome)
## [1] TRUE
# Compare with the former algorithm (BP 85)
new_2dfOutcome <- data.frame(nOutcome=bp85_uq002$uq_Res, 
                             wts=colSums(diag(bp85_uq002$cWeight) %*% bp85_uq002$uq_Play)
                             )
new_5dfOutcome <- data.frame(nOutcome=bp85_uq005$uq_Res, 
                             wts=colSums(diag(bp85_uq005$cWeight) %*% bp85_uq005$uq_Play)
                             )

bp85_2Play <- assessNPlay(keyList=bp85UniqueList, nPlay=2L)
## List of 2
##  $ : int [1:144] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:144] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:144, 1:2] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2]
## [1,]    1    1
## [2,]    1    2
## [3,]    1    3
## [4,]    1    4
## [5,]    1    5
## [6,]    1    6
## 
## 
## Number of unique outcome types: 63 
## 
## Moving to assess the: 63 rows of outcomes
## 
## 
## Mean: 0.9916597      Variance: 46.04822
bp85_5Play <- assessNPlay(keyList=bp85UniqueList, nPlay=5L)
## List of 5
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 722 
## 
## Moving to assess the: 722 rows of outcomes
##  num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 ...
## [1] 100
##  num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:1647, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1647, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1647, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## 
## 
## Mean: 0.9916597      Variance: 146.9209
all.equal(as.data.frame(bp85_2Play$dfOutcome[, -2]), new_2dfOutcome)
## [1] TRUE
all.equal(as.data.frame(bp85_5Play$dfOutcome[, -2]), new_5dfOutcome)
## [1] TRUE
# Compare with the former algorithm (TDB 96)
new_2dfOutcome <- data.frame(nOutcome=tdb96_uq002$uq_Res, 
                             wts=colSums(diag(tdb96_uq002$cWeight) %*% tdb96_uq002$uq_Play)
                             )
new_5dfOutcome <- data.frame(nOutcome=tdb96_uq005$uq_Res, 
                             wts=colSums(diag(tdb96_uq005$cWeight) %*% tdb96_uq005$uq_Play)
                             )

tdb96_2Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=2L)
## List of 2
##  $ : int [1:121] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:121] 1 2 3 4 5 6 7 8 9 10 ...
## 
##   1 
## 945 
##  int [1:121, 1:2] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2]
## [1,]    1    1
## [2,]    1    2
## [3,]    1    3
## [4,]    1    4
## [5,]    1    5
## [6,]    1    6
## 
## 
## Number of unique outcome types: 59 
## 
## Moving to assess the: 59 rows of outcomes
## 
## 
## Mean: 0.98154        Variance: 221.5844
tdb96_5Play <- assessNPlay(keyList=tdb96UniqueList, nPlay=5L)
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##   1 
## 945 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1064 
## 
## Moving to assess the: 1064 rows of outcomes
##  num [1:945, 1:220] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:945, 1:390] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:945, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 ...
## [1] 400
##  num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:945, 1:290] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 ...
## [1] 600
##  num [1:945, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:945, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:945, 1:115] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0.0158 0 ...
## [1] 900
##  num [1:945, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:945] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.98154        Variance: 714.1226
all.equal(as.data.frame(tdb96_2Play$dfOutcome[, -2]), new_2dfOutcome)
## [1] TRUE
all.equal(as.data.frame(tdb96_5Play$dfOutcome[, -2]), new_5dfOutcome)
## [1] TRUE

So, the algorithm is a quicker way for expanding n-Play for reasonably small values of n (in the ~5 range) that preserve the “by outcome flavor” nature of the matrix.

Additionally, an algorithm is written to simplify away flavors that have a very low probability of occuring. For example, while it is theoretically possible to get 4 RF and 1 4 AwaK by holding a naked Ace, the probabilities of this occuring are vanishingly small. Because the matrices propagate forward, this very improbable outcome can then be combined with getting an A-5 SF, 4 2/3/4wA, and the like. The upshot is a lot of clutter in the matrices (straining memory and run-time) with no pragmatic impact on mean and variance.

As a default, an outcome (N-play flavor) is considered to be extremely unlikely if it would be observed less that once ever 25 billion dealt hands (10,000 cycles), though this tolerance can be adjusted. These probabilities can either be ignored (all other probabilities scaled up accordingly), placed in their own column with the appropriate mean, or allocated to existing columns nearest to them.

clean_NPlay <- function(nPlayInput, nTol=0.0001, reAlloc=TRUE, makeOwn=TRUE) {
    
    # Anything with occurence less than nTol per choose(52, 5) will be excluded from the output
    # If reAlloc==TRUE then all other elements are scaled up to get total back to choose(52, 5)
    # If reAlloc==FALSE and makeOwn==TRUE, all exclusions are aggregated a single "new" column
    # If reAlloc==FALSE and makeOwn==FALSE, all exclusions are re-assigned to the closest column
    
    cWeight <- nPlayInput$cWeight
    uq_Play <- nPlayInput$uq_Play
    uq_Res <- nPlayInput$uq_Res
    
    colWts <- colSums( cWeight * uq_Play )
    tooSmall <- (colWts < nTol)
    
    # Grab the contributions tomean and variance for tooSmall, !tooSmall, and all
    fullSum <- sum(colWts * uq_Res)
    lrgSum <- sum(colWts[!tooSmall] * uq_Res[!tooSmall])
    smlSum <- sum(colWts[tooSmall] * uq_Res[tooSmall])
    
    fullSum2 <- sum(colWts * uq_Res^2)
    lrgSum2 <- sum(colWts[!tooSmall] * uq_Res[!tooSmall]^2)
    smlSum2 <- sum(colWts[tooSmall] * uq_Res[tooSmall]^2)    
    
    
    cat("\n\nContributions to SUM:", 
        prettyNum(round(fullSum, 1), big.mark=","), 
        prettyNum(round(lrgSum, 1), big.mark=","), 
        paste0("(", round(100*lrgSum/fullSum, 2), "%)"), 
        prettyNum(round(smlSum, 1), big.mark=","), 
        paste0("(", round(100*smlSum/fullSum, 2), "%)")
        )

    cat("\nContributions to SUM-SQUARED:", 
        prettyNum(round(fullSum2, 0), big.mark=","), 
        prettyNum(round(lrgSum2, 0), big.mark=","), 
        paste0("(", round(100*lrgSum2/fullSum2, 2), "%)"), 
        prettyNum(round(smlSum2, 0), big.mark=","), 
        paste0("(", round(100*smlSum2/fullSum2, 2), "%)")
        )
    
    cat("\n\nMeans Assuming All, Large, Small:", 
        round(fullSum/sum(colWts), 6),
        round(lrgSum/sum(colWts[!tooSmall]), 6), 
        round(smlSum/sum(colWts[tooSmall]), 6)
        )
    
    cat("\nVariances Assuming All, Large, Small:", 
        prettyNum(fullSum2/sum(colWts) - (fullSum/sum(colWts))^2, big.mark=","),
        prettyNum(lrgSum2/sum(colWts[!tooSmall]) - (lrgSum/sum(colWts[!tooSmall]))^2, big.mark=","), 
        prettyNum(smlSum2/sum(colWts[tooSmall]) - (smlSum/sum(colWts[tooSmall]))^2, big.mark=","), 
        "\n"
        )

    if (isTRUE(reAlloc)) {
        cleanNList <- list(uq_Play=(uq_Play[, !tooSmall] / rowSums(uq_Play[, !tooSmall])), 
                           uq_Res=uq_Res[!tooSmall], 
                           cWeight=cWeight
                           )
    } else if (isTRUE(makeOwn)) {
        uqOwnMean <- round(smlSum/sum(colWts[tooSmall]), 4)
        uqOwnOdds <- 1 - rowSums(uq_Play[, !tooSmall])
        
        cleanNList <- list(uq_Play=cbind(uq_Play[, !tooSmall], uqOwnOdds), 
                           uq_Res=c(uq_Res[!tooSmall], uqOwnMean), 
                           cWeight=cWeight
                           )        
    } else {
        stop("Still need to implement other return modes")
    }
    
    newCSum <- colSums(cleanNList$cWeight * cleanNList$uq_Play)
    cat("\nMeans shifted from/to:", 
        round(fullSum/sum(colWts), 6), 
        round(sum(newCSum * cleanNList$uq_Res)/sum(newCSum), 6)
        )
    cat("\nE[X^2] shifted from/to:", 
        round(fullSum2/sum(colWts), 3), 
        round(sum(newCSum * cleanNList$uq_Res^2)/sum(newCSum), 3),
        "\n\n"
        )
    
    cleanNList
        
}

Several initial runs of the methodology are cached for run-time optimization:

# Expand BP 85 (carefully) to 10-play (using default re-allocations)
bp85_cl005 <- clean_NPlay(nPlayInput=bp85_uq005)
## 
## 
## Contributions to SUM: -108,380.1 -108,381.2 (100%) 1.1 (0%)
## Contributions to SUM-SQUARED: 381,846,163 381,844,232 (100%) 1,931 (0%)
## 
## Means Assuming All, Large, Small: -0.041701 -0.041702 1005.985
## Variances Assuming All, Large, Small: 146.9209 146.9202 761,942.2 
## 
## Means shifted from/to: -0.041701 -0.041702
## E[X^2] shifted from/to: 146.923 146.922
bp85_uqcl006 <- create_mnPlay(keyN=bp85_cl005, keyM=bp85_uq001)

bp85_cl006 <- clean_NPlay(nPlayInput=bp85_uqcl006)
## 
## 
## Contributions to SUM: -130,057.2 -130,059.3 (100%) 2.1 (0%)
## Contributions to SUM-SQUARED: 491,273,735 491,269,195 (100%) 4,540 (0%)
## 
## Means Assuming All, Large, Small: -0.050042 -0.050043 1357.013
## Variances Assuming All, Large, Small: 189.0245 189.0228 1,072,699 
## 
## Means shifted from/to: -0.050042 -0.050043
## E[X^2] shifted from/to: 189.027 189.025
bp85_uqcl007 <- create_mnPlay(keyN=bp85_cl006, keyM=bp85_uq001)

bp85_cl007 <- clean_NPlay(nPlayInput=bp85_uqcl007)
## 
## 
## Contributions to SUM: -151,735.3 -151,738.8 (100%) 3.5 (0%)
## Contributions to SUM-SQUARED: 611,718,784 611,711,052 (100%) 7,732 (0%)
## 
## Means Assuming All, Large, Small: -0.058383 -0.058384 1407.485
## Variances Assuming All, Large, Small: 235.3672 235.3642 1,129,266 
## 
## Means shifted from/to: -0.058383 -0.058384
## E[X^2] shifted from/to: 235.371 235.368
bp85_uqcl008 <- create_mnPlay(keyN=bp85_cl007, keyM=bp85_uq001)

bp85_cl008 <- clean_NPlay(nPlayInput=bp85_uqcl008)
## 
## 
## Contributions to SUM: -173,414.6 -173,419 (100%) 4.4 (0%)
## Contributions to SUM-SQUARED: 743,180,710 743,170,588 (100%) 10,122 (0%)
## 
## Means Assuming All, Large, Small: -0.066725 -0.066726 1419.243
## Variances Assuming All, Large, Small: 285.9487 285.9448 1,276,972 
## 
## Means shifted from/to: -0.066725 -0.066726
## E[X^2] shifted from/to: 285.953 285.949
bp85_uqcl009 <- create_mnPlay(keyN=bp85_cl008, keyM=bp85_uq001)

bp85_cl009 <- clean_NPlay(nPlayInput=bp85_uqcl009)
## 
## 
## Contributions to SUM: -195,094.7 -195,101.6 (100%) 6.9 (0%)
## Contributions to SUM-SQUARED: 885,660,269 885,643,513 (100%) 16,755 (0%)
## 
## Means Assuming All, Large, Small: -0.075066 -0.075069 1653.267
## Variances Assuming All, Large, Small: 340.7692 340.7628 1,262,329 
## 
## Means shifted from/to: -0.075066 -0.075069
## E[X^2] shifted from/to: 340.775 340.769
bp85_uqcl010_reAlloc <- create_mnPlay(keyN=bp85_cl009, keyM=bp85_uq001)

bp85_cl010_reAlloc <- clean_NPlay(nPlayInput=bp85_uqcl010_reAlloc)
## 
## 
## Contributions to SUM: -216,777.2 -216,785.4 (100%) 8.3 (0%)
## Contributions to SUM-SQUARED: 1,039,153,280 1,039,132,256 (100%) 21,025 (0%)
## 
## Means Assuming All, Large, Small: -0.083409 -0.083412 1675.765
## Variances Assuming All, Large, Small: 399.8273 399.8192 1,453,131 
## 
## Means shifted from/to: -0.083409 -0.083412
## E[X^2] shifted from/to: 399.834 399.826
# Expand BP 85 (carefully) to 10-play (using own means)
bp85_cl005 <- clean_NPlay(nPlayInput=bp85_uq005, reAlloc=FALSE, makeOwn=TRUE)
## 
## 
## Contributions to SUM: -108,380.1 -108,381.2 (100%) 1.1 (0%)
## Contributions to SUM-SQUARED: 381,846,163 381,844,232 (100%) 1,931 (0%)
## 
## Means Assuming All, Large, Small: -0.041701 -0.041702 1005.985
## Variances Assuming All, Large, Small: 146.9209 146.9202 761,942.2 
## 
## Means shifted from/to: -0.041701 -0.041701
## E[X^2] shifted from/to: 146.923 146.922
bp85_uqcl006 <- create_mnPlay(keyN=bp85_cl005, keyM=bp85_uq001)

bp85_cl006 <- clean_NPlay(nPlayInput=bp85_uqcl006, reAlloc=FALSE, makeOwn=TRUE)
## 
## 
## Contributions to SUM: -130,056.1 -130,058.4 (100%) 2.3 (0%)
## Contributions to SUM-SQUARED: 491,274,824 491,270,111 (100%) 4,713 (0%)
## 
## Means Assuming All, Large, Small: -0.050042 -0.050042 1328.323
## Variances Assuming All, Large, Small: 189.025 189.0231 985,569.8 
## 
## Means shifted from/to: -0.050042 -0.050042
## E[X^2] shifted from/to: 189.027 189.027
bp85_uqcl007 <- create_mnPlay(keyN=bp85_cl006, keyM=bp85_uq001)

bp85_cl007 <- clean_NPlay(nPlayInput=bp85_uqcl007, reAlloc=FALSE, makeOwn=TRUE)
## 
## 
## Contributions to SUM: -151,732.2 -151,736 (100%) 3.9 (0%)
## Contributions to SUM-SQUARED: 611,722,693 611,714,472 (100%) 8,221 (0%)
## 
## Means Assuming All, Large, Small: -0.058382 -0.058383 1383.576
## Variances Assuming All, Large, Small: 235.3687 235.3655 1,014,200 
## 
## Means shifted from/to: -0.058382 -0.058382
## E[X^2] shifted from/to: 235.372 235.371
bp85_uqcl008 <- create_mnPlay(keyN=bp85_cl007, keyM=bp85_uq001)

bp85_cl008 <- clean_NPlay(nPlayInput=bp85_uqcl008, reAlloc=FALSE, makeOwn=TRUE)
## 
## 
## Contributions to SUM: -173,408.2 -173,413.2 (100%) 5.1 (0%)
## Contributions to SUM-SQUARED: 743,189,461 743,178,357 (100%) 11,104 (0%)
## 
## Means Assuming All, Large, Small: -0.066722 -0.066724 1407.355
## Variances Assuming All, Large, Small: 285.952 285.9478 1,108,593 
## 
## Means shifted from/to: -0.066722 -0.066722
## E[X^2] shifted from/to: 285.956 285.955
bp85_uqcl009 <- create_mnPlay(keyN=bp85_cl008, keyM=bp85_uq001)

bp85_cl009 <- clean_NPlay(nPlayInput=bp85_uqcl009, reAlloc=FALSE, makeOwn=TRUE)
## 
## 
## Contributions to SUM: -195,084.2 -195,092.3 (100%) 8.1 (0%)
## Contributions to SUM-SQUARED: 885,675,135 885,656,711 (100%) 18,424 (0%)
## 
## Means Assuming All, Large, Small: -0.075062 -0.075066 1613.281
## Variances Assuming All, Large, Small: 340.775 340.7679 1,082,761 
## 
## Means shifted from/to: -0.075062 -0.075062
## E[X^2] shifted from/to: 340.781 340.779
bp85_uqcl010_makeOwn <- create_mnPlay(keyN=bp85_cl009, keyM=bp85_uq001)

bp85_cl010_makeOwn <- clean_NPlay(nPlayInput=bp85_uqcl010_makeOwn, 
                                  reAlloc=FALSE, makeOwn=TRUE
                                  )
## 
## 
## Contributions to SUM: -216,760.2 -216,770.1 (100%) 9.9 (0%)
## Contributions to SUM-SQUARED: 1,039,179,419 1,039,155,803 (100%) 23,616 (0%)
## 
## Means Assuming All, Large, Small: -0.083403 -0.083406 1644.14
## Variances Assuming All, Large, Small: 399.8374 399.8283 1,218,110 
## 
## Means shifted from/to: -0.083403 -0.083403
## E[X^2] shifted from/to: 399.844 399.842
# Comparisons of results
bp85_cl010_reAlloc <- clean_NPlay(nPlayInput=bp85_uqcl010_reAlloc)
## 
## 
## Contributions to SUM: -216,777.2 -216,785.4 (100%) 8.3 (0%)
## Contributions to SUM-SQUARED: 1,039,153,280 1,039,132,256 (100%) 21,025 (0%)
## 
## Means Assuming All, Large, Small: -0.083409 -0.083412 1675.765
## Variances Assuming All, Large, Small: 399.8273 399.8192 1,453,131 
## 
## Means shifted from/to: -0.083409 -0.083412
## E[X^2] shifted from/to: 399.834 399.826
bp85_cl010_makeOwn <- clean_NPlay(nPlayInput=bp85_uqcl010_makeOwn, 
                                  reAlloc=FALSE, makeOwn=TRUE
                                  )
## 
## 
## Contributions to SUM: -216,760.2 -216,770.1 (100%) 9.9 (0%)
## Contributions to SUM-SQUARED: 1,039,179,419 1,039,155,803 (100%) 23,616 (0%)
## 
## Means Assuming All, Large, Small: -0.083403 -0.083406 1644.14
## Variances Assuming All, Large, Small: 399.8374 399.8283 1,218,110 
## 
## Means shifted from/to: -0.083403 -0.083403
## E[X^2] shifted from/to: 399.844 399.842
useWeight <- bp85UniqueList$uqCards[, ncol(bp85UniqueList$uqCards)]
theoMean <- weighted.mean(bp85UniqueList$uqFrame$uqMean, w=useWeight)
theoDealVar <- var(rep(bp85List$tempSmallMax[1, ], times=cardWeight))
theoDrawVar <- mean(rep(bp85UniqueList$uqFrame$uqVar, times=useWeight))

cat("\n\n10-play BP 85 should have mean:", round(10*theoMean, 6), "with variance:", 
    10 * (10 * theoDealVar + theoDrawVar), "\n"
    )
## 
## 
## 10-play BP 85 should have mean: -0.083403 with variance: 399.8433

At least for projecting BP 85 to 10-play, the “make own” methodology is extremely closely tied to theoretical outcomes.

The next step is to significantly optimize the core of the propagation algorithm so that it does not need to maintain so many zeroes. A simplified function is attempted to use “for” loops to sum columns (potentially much faster for larger matrices since there is no need to keep a large “multiplying” matrix):

# Function to cross-product n-play and m-play
forCreate_mnPlay <- function(keyN, keyM) {
 
    # Sum outcomes for matrix cross product (column values for aTest)
    aScore <- outer(keyN$uq_Res, keyM$uq_Res, FUN="+")
    
    # Find and sort the unique scores
    uqScores <- sort(unique(as.vector(aScore)))

    # Test this using the for loop instead
    uq_Play <- matrix(data=0, nrow=nrow(keyN$uq_Play), ncol=length(uqScores))
    for (intCtr in seq_along(uqScores)) {
        # Find elements to be cross-multiplied
        multN <- row(aScore)[aScore == uqScores[intCtr]]
        multM <- col(aScore)[aScore == uqScores[intCtr]]
        
        uq_Play[, intCtr] <- rowSums(keyN$uq_Play[, multN, drop=FALSE] * 
                                         keyM$uq_Play[, multM, drop=FALSE]
                                     )
        
    }

    list(uq_Play=uq_Play, uq_Res=uqScores, cWeight=keyN$cWeight)
        
}

The algorithm is then attempted for expansions to 2-play through 5-play:

# Take JB 96, BP 85, and TDB 96 and expand from 1-play to 2/5 play
startTime <- proc.time()
jb96_uq002_for <- forCreate_mnPlay(keyN=jb96_uq001, keyM=jb96_uq001)
jb96_uq005_for <- forCreate_mnPlay(keyN=jb96_uq004, keyM=jb96_uq001)
proc.time() - startTime
##    user  system elapsed 
##    0.08    0.00    0.08
startTime <- proc.time()
bp85_uq002_for <- forCreate_mnPlay(keyN=bp85_uq001, keyM=bp85_uq001)
bp85_uq005_for <- forCreate_mnPlay(keyN=bp85_uq004, keyM=bp85_uq001)
proc.time() - startTime
##    user  system elapsed 
##     0.2     0.0     0.2
startTime <- proc.time()
tdb96_uq002_for <- forCreate_mnPlay(keyN=tdb96_uq001, keyM=tdb96_uq001)
tdb96_uq005_for <- forCreate_mnPlay(keyN=tdb96_uq004, keyM=tdb96_uq001)
proc.time() - startTime
##    user  system elapsed 
##    0.19    0.00    0.19
# Compare with the former algorithm
all.equal(jb96_uq002, jb96_uq002_for)
## [1] TRUE
all.equal(jb96_uq005, jb96_uq005_for)
## [1] TRUE
all.equal(bp85_uq002, bp85_uq002_for)
## [1] TRUE
all.equal(bp85_uq005, bp85_uq005_for)
## [1] TRUE
all.equal(tdb96_uq002, tdb96_uq002_for)
## [1] TRUE
all.equal(tdb96_uq005, tdb96_uq005_for)
## [1] TRUE

The algorithm is then again run for expansions to 10/15-play, with results cached for improved run times:

# Expansion to 10-play
startTime <- proc.time()
jb96_uq010 <- forCreate_mnPlay(keyN=jb96_uq005, keyM=jb96_uq005)
thisList <- jb96_uq010
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nJB 96 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))
## 
## JB 96 10-play has return: -0.04561 and variance: 372.12
proc.time() - startTime
##    user  system elapsed 
##   10.93    2.18   13.28
startTime <- proc.time()
bp85_uq010_cl <- forCreate_mnPlay(keyN=bp85_cl005, keyM=bp85_cl005)
thisList <- bp85_uq010_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nBP 85 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))
## 
## BP 85 10-play has return: -0.083403 and variance: 399.84
proc.time() - startTime
##    user  system elapsed 
##    5.74    1.76    7.66
startTime <- proc.time()
tdb96_cl005 <- clean_NPlay(nPlayInput=tdb96_uq005)
## 
## 
## Contributions to SUM: -239,884.5 -239,886 (100%) 1.5 (0%)
## Contributions to SUM-SQUARED: 1,855,998,103 1,855,995,526 (100%) 2,577 (0%)
## 
## Means Assuming All, Large, Small: -0.0923 -0.092301 798.0552
## Variances Assuming All, Large, Small: 714.1226 714.1216 721,907.6 
## 
## Means shifted from/to: -0.0923 -0.092301
## E[X^2] shifted from/to: 714.131 714.13
tdb96_uq010_cl <- forCreate_mnPlay(keyN=tdb96_cl005, keyM=tdb96_cl005)
thisList <- tdb96_uq010_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nTDB 96 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))
## 
## TDB 96 10-play has return: -0.184602 and variance: 1962.11
proc.time() - startTime
##    user  system elapsed 
##   14.23    3.82   18.26
# Expansion to 15-play
startTime <- proc.time()
jb96_cl005 <- clean_NPlay(nPlayInput=jb96_uq005)
## 
## 
## Contributions to SUM: -59,268.7 -59,269.5 (100%) 0.8 (0%)
## Contributions to SUM-SQUARED: 355,801,979 355,800,279 (100%) 1,700 (0%)
## 
## Means Assuming All, Large, Small: -0.022805 -0.022805 1300.044
## Variances Assuming All, Large, Small: 136.9012 136.9005 1,086,441 
## 
## Means shifted from/to: -0.022805 -0.022805
## E[X^2] shifted from/to: 136.902 136.901
jb96_cl010 <- clean_NPlay(nPlayInput=jb96_uq010)
## 
## 
## Contributions to SUM: -118,537.4 -118,551.2 (100.01%) 13.7 (-0.01%)
## Contributions to SUM-SQUARED: 967,134,937 967,097,447 (100%) 37,490 (0%)
## 
## Means Assuming All, Large, Small: -0.04561 -0.045615 1978.338
## Variances Assuming All, Large, Small: 372.1217 372.1073 1,484,668 
## 
## Means shifted from/to: -0.04561 -0.045614
## E[X^2] shifted from/to: 372.124 372.11
jb96_uq015_cl <- forCreate_mnPlay(keyN=jb96_cl010, keyM=jb96_cl005)
thisList <- jb96_uq015_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nJB 96 15-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))
## 
## JB 96 15-play has return: -0.068419 and variance: 705.65
proc.time() - startTime
##    user  system elapsed 
##   10.72    2.73   13.70
startTime <- proc.time()
bp85_cl010 <- clean_NPlay(nPlayInput=bp85_uq010_cl)
## 
## 
## Contributions to SUM: -216,760.2 -216,773.4 (100.01%) 13.2 (-0.01%)
## Contributions to SUM-SQUARED: 1,039,192,798 1,039,159,064 (100%) 33,733 (0%)
## 
## Means Assuming All, Large, Small: -0.083403 -0.083408 1765.973
## Variances Assuming All, Large, Small: 399.8425 399.8295 1,393,269 
## 
## Means shifted from/to: -0.083403 -0.083407
## E[X^2] shifted from/to: 399.849 399.837
bp85_uq015_cl <- forCreate_mnPlay(keyN=bp85_cl010, keyM=bp85_cl005)
thisList <- bp85_uq015_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nBP 85 15-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))
## 
## BP 85 15-play has return: -0.125109 and variance: 758.75
proc.time() - startTime
##    user  system elapsed 
##   18.11    4.51   23.18
startTime <- proc.time()
tdb96_cl010 <- clean_NPlay(nPlayInput=tdb96_uq010_cl)
## 
## 
## Contributions to SUM: -479,772.1 -479,789 (100%) 17 (0%)
## Contributions to SUM-SQUARED: 5,099,546,473 5,099,502,905 (100%) 43,568 (0%)
## 
## Means Assuming All, Large, Small: -0.184602 -0.184608 1803.959
## Variances Assuming All, Large, Small: 1,962.115 1,962.098 1,378,680 
## 
## Means shifted from/to: -0.184602 -0.184608
## E[X^2] shifted from/to: 1962.149 1962.132
tdb96_uq015_cl <- forCreate_mnPlay(keyN=tdb96_cl010, keyM=tdb96_cl005)
thisList <- tdb96_uq015_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nTDB 96 15-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))
## 
## TDB 96 15-play has return: -0.276908 and variance: 3743.96
proc.time() - startTime
##    user  system elapsed 
##   52.67   13.29   67.61
# Theoretical expectations for 10-play and 15-play
useWeight <- jb96UniqueList$uqCards[, ncol(jb96UniqueList$uqCards)]
theoMean <- weighted.mean(jb96UniqueList$uqFrame$uqMean, w=useWeight)
theoDealVar <- var(rep(jb96List$tempSmallMax[1, ], times=cardWeight))
theoDrawVar <- mean(rep(jb96UniqueList$uqFrame$uqVar, times=useWeight))

cat("\n\n10-play JB 96 should have mean:", round(10*theoMean, 6), "with variance:", 
    10 * (10 * theoDealVar + theoDrawVar), "\n"
    )
## 
## 
## 10-play JB 96 should have mean: -0.04561 with variance: 372.1218
cat("\n\n15-play JB 96 should have mean:", round(15*theoMean, 6), "with variance:", 
    15 * (15 * theoDealVar + theoDrawVar), "\n"
    )
## 
## 
## 15-play JB 96 should have mean: -0.068414 with variance: 705.6619
useWeight <- bp85UniqueList$uqCards[, ncol(bp85UniqueList$uqCards)]
theoMean <- weighted.mean(bp85UniqueList$uqFrame$uqMean, w=useWeight)
theoDealVar <- var(rep(bp85List$tempSmallMax[1, ], times=cardWeight))
theoDrawVar <- mean(rep(bp85UniqueList$uqFrame$uqVar, times=useWeight))

cat("\n\n10-play BP 85 should have mean:", round(10*theoMean, 6), "with variance:", 
    10 * (10 * theoDealVar + theoDrawVar), "\n"
    )
## 
## 
## 10-play BP 85 should have mean: -0.083403 with variance: 399.8433
cat("\n\n15-play BP 85 should have mean:", round(15*theoMean, 6), "with variance:", 
    15 * (15 * theoDealVar + theoDrawVar), "\n"
    )
## 
## 
## 15-play BP 85 should have mean: -0.125104 with variance: 758.767
useWeight <- tdb96UniqueList$uqCards[, ncol(tdb96UniqueList$uqCards)]
theoMean <- weighted.mean(tdb96UniqueList$uqFrame$uqMean, w=useWeight)
theoDealVar <- var(rep(tdb96List$tempSmallMax[1, ], times=cardWeight))
theoDrawVar <- mean(rep(tdb96UniqueList$uqFrame$uqVar, times=useWeight))

cat("\n\n10-play TDB 96 should have mean:", round(10*theoMean, 6), "with variance:", 
    10 * (10 * theoDealVar + theoDrawVar), "\n"
    )
## 
## 
## 10-play TDB 96 should have mean: -0.1846 with variance: 1962.117
cat("\n\n15-play TDB 96 should have mean:", round(15*theoMean, 6), "with variance:", 
    15 * (15 * theoDealVar + theoDrawVar), "\n"
    )
## 
## 
## 15-play TDB 96 should have mean: -0.276901 with variance: 3743.984

One other attempt is made to run the matrix multiplications, this time going row-by-row rather than column-by-column:

# Function to cross-product n-play and m-play
forRowCreate_mnPlay <- function(keyN, keyM) {
 
    # Sum outcomes for matrix cross product (column values for aTest)
    aScore <- as.vector(outer(keyN$uq_Res, keyM$uq_Res, FUN="+"))
    
    # Find and sort the unique scores
    uqScores <- sort(unique(as.vector(aScore)))

    # Create the unique play matrix
    uq_Play <- matrix(data=0, nrow=nrow(keyN$uq_Play), ncol=length(uqScores))

    # Get the multipliers
    mapScores <- match(aScore, uqScores)
    
    # Test this using the for loop instead
    for (intCtr in seq_len(nrow(keyN$uq_Play))) {
        
        # Get the outer product of the key row
        tmpOuter <- as.vector(outer(keyN$uq_Play[intCtr, ], keyM$uq_Play[intCtr, ], FUN="*"))
        
        tmpVector <- data.frame(colNum=mapScores, pctVal=tmpOuter) %>% 
            group_by(colNum) %>% 
            summarize(totPct=sum(pctVal))
        
        uq_Play[intCtr, ] <- as.data.frame(tmpVector)[, 2]

        if (intCtr %% 100 == 0) { cat("\nProcessed row", intCtr) }
        
    }

    list(uq_Play=uq_Play, uq_Res=uqScores, cWeight=keyN$cWeight)
        
}


# Compare timing

startTime <- proc.time()
tdb96_cl005 <- clean_NPlay(nPlayInput=tdb96_uq005)
## 
## 
## Contributions to SUM: -239,884.5 -239,886 (100%) 1.5 (0%)
## Contributions to SUM-SQUARED: 1,855,998,103 1,855,995,526 (100%) 2,577 (0%)
## 
## Means Assuming All, Large, Small: -0.0923 -0.092301 798.0552
## Variances Assuming All, Large, Small: 714.1226 714.1216 721,907.6 
## 
## Means shifted from/to: -0.0923 -0.092301
## E[X^2] shifted from/to: 714.131 714.13
tdb96_uq010_cl <- forRowCreate_mnPlay(keyN=tdb96_cl005, keyM=tdb96_cl005)
## 
## Processed row 100
## Processed row 200
## Processed row 300
## Processed row 400
## Processed row 500
## Processed row 600
## Processed row 700
## Processed row 800
## Processed row 900
thisList <- tdb96_uq010_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nTDB 96 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))
## 
## TDB 96 10-play has return: -0.184602 and variance: 1962.11
proc.time() - startTime
##    user  system elapsed 
##   14.05    0.00   14.14
startTime <- proc.time()
tdb96_cl005 <- clean_NPlay(nPlayInput=tdb96_uq005)
## 
## 
## Contributions to SUM: -239,884.5 -239,886 (100%) 1.5 (0%)
## Contributions to SUM-SQUARED: 1,855,998,103 1,855,995,526 (100%) 2,577 (0%)
## 
## Means Assuming All, Large, Small: -0.0923 -0.092301 798.0552
## Variances Assuming All, Large, Small: 714.1226 714.1216 721,907.6 
## 
## Means shifted from/to: -0.0923 -0.092301
## E[X^2] shifted from/to: 714.131 714.13
tdb96_uq010_cl <- forCreate_mnPlay(keyN=tdb96_cl005, keyM=tdb96_cl005)
thisList <- tdb96_uq010_cl
nEX <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res ) / sum(thisList$cWeight)
nEX2 <- sum( colSums( thisList$cWeight * thisList$uq_Play ) * 
                thisList$uq_Res^2 ) / sum(thisList$cWeight)
cat("\nTDB 96 10-play has return:", round(nEX, 6), "and variance:", round(nEX2-nEX^2, 2))
## 
## TDB 96 10-play has return: -0.184602 and variance: 1962.11
proc.time() - startTime
##    user  system elapsed 
##   13.34    1.09   14.51

The timing is nearly identical; the processing by row does not seem to save any substantial amounts of time.

Next, the microbenchmark library is explored on some sample data to better understand the timing implications of various matrix approaches. Each row of the matrices is an independent instanciation that should be preserved, with columns multiplied in an “outer product” manner, then summarized back:

library(microbenchmark)


# Approach one is to multiply out all columns corresponding to a key result
testByRes <- function(dOne=dataOne, dTwo=dataTwo, dOut=dataOut, 
                      cUq=colRes_uq, cTot=colRes) {
    
    for (intCtr in seq_along(cUq)) { 
        keyColN <- row(cTot)[cTot == cUq[intCtr]]
        keyColM <- col(cTot)[cTot == cUq[intCtr]] 
        dOut[, intCtr] <- rowSums( dOne$uq_Play[, keyColN, drop=FALSE] * 
                                       dTwo$uq_Play[, keyColM, drop=FALSE] 
                                   ) 
    }
    
    dOut
    
}

# Approach two is to run the process one row at a time
testByRow <- function(dOne=dataOne, dTwo=dataTwo, dOut=dataOut, 
                      cUq=colRes_uq, cTot=colRes) {
    
    mapScores <- match(as.vector(cTot), cUq)
    
    for (intCtr in seq_len(nrow(dOne$uq_Play))) { 
        outMult <- outer(dOne$uq_Play[intCtr, ], dTwo$uq_Play[intCtr, ])
        outGroup <- data.frame(keyRow=mapScores, keyVal=as.vector(outMult)) %>%
            group_by(keyRow) %>%
            summarize(keyVal=sum(keyVal))
        dOut[intCtr, ] <- as.data.frame(outGroup)[, 2]
    }
    
    dOut
    
}

The below runs are cached for run-time optimization:

# Matrix one will be the JB 96 2-play data, and matrix two will be the JB 96 2-play data
dataOne <- jb96_uq002
str(dataOne)
## List of 3
##  $ uq_Play: num [1:1279, 1:42] 0 0 0 0 0.493 ...
##  $ uq_Res : num [1:42] -2 -1 0 1 2 3 4 5 6 7 ...
##  $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
##   ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...
dataTwo <- jb96_uq002
str(dataTwo)
## List of 3
##  $ uq_Play: num [1:1279, 1:42] 0 0 0 0 0.493 ...
##  $ uq_Res : num [1:42] -2 -1 0 1 2 3 4 5 6 7 ...
##  $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
##   ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...
# The column addition results are calculated
colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
str(colRes)
##  num [1:42, 1:42] -4 -3 -2 -1 0 1 2 3 4 5 ...
colRes_uq <- sort(unique(as.vector(colRes)))
str(colRes_uq)
##  num [1:235] -4 -3 -2 -1 0 1 2 3 4 5 ...
# The objective is then to matrix multiply the uqPlay data
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))
str(dataOut)
##  int [1:1279, 1:235] 0 0 0 0 0 0 0 0 0 0 ...
microbenchmark(tRes=(tempRes <- testByRes()), 
               tRow=(tempRow <- testByRow()),
               times=10L
               )
## Unit: milliseconds
##  expr        min        lq       mean     median         uq        max
##  tRes   38.91487   39.4166   42.13662   40.50395   43.76521   50.79421
##  tRow 1615.41942 1657.6538 1733.51017 1716.43070 1774.84840 1932.58546
##  neval cld
##     10  a 
##     10   b
# Matrix one will be the JB 96 4-play data, and matrix two will be the JB 96 3-play data
dataOne <- jb96_uq004
str(dataOne)
## List of 3
##  $ uq_Play: num [1:1279, 1:235] 0 0 0 0 0.243 ...
##  $ uq_Res : num [1:235] -4 -3 -2 -1 0 1 2 3 4 5 ...
##  $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
##   ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...
dataTwo <- jb96_uq003
str(dataTwo)
## List of 3
##  $ uq_Play: num [1:1279, 1:114] 0 0 0 0 0.346 ...
##  $ uq_Res : num [1:114] -3 -2 -1 0 1 2 3 4 5 6 ...
##  $ cWeight: Named num [1:1279] 624 3744 54912 123552 96 ...
##   ..- attr(*, "names")= chr [1:1279] "1" "2" "3" "4" ...
# The column addition results are calculated
colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
str(colRes)
##  num [1:235, 1:114] -7 -6 -5 -4 -3 -2 -1 0 1 2 ...
colRes_uq <- sort(unique(as.vector(colRes)))
str(colRes_uq)
##  num [1:898] -7 -6 -5 -4 -3 -2 -1 0 1 2 ...
# The objective is then to matrix multiply the uqPlay data
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))
str(dataOut)
##  int [1:1279, 1:898] 0 0 0 0 0 0 0 0 0 0 ...
microbenchmark(tRes=(tempRes <- testByRes()), 
               tRow=(tempRow <- testByRow()),
               times=10L
               )
## Unit: milliseconds
##  expr       min       lq     mean   median       uq      max neval cld
##  tRes  986.7236 1043.700 1146.076 1107.755 1225.944 1379.304    10  a 
##  tRow 4532.2317 4806.177 5083.608 5039.002 5254.335 5973.379    10   b

Running the results by unique outcome seems substantially faster than running results by hand flavor, at least for the 2x2 and 4x3 examples above.

Next, exploration of column sums by means of sapply is explored:

# Create and use aTest
create_Sapply01_mnPlay <- function(keyN, keyM) {
    
    aTest <- matrix(data=0, nrow=nrow(keyN$uq_Play), 
                    ncol=ncol(keyM$uq_Play)*ncol(keyN$uq_Play)
                    )
    
    # Matrix multiply by "flavor" (unique rows)
    for (intCtr in 1:nrow(keyN$uq_Play)) {
        aTest[intCtr, ] <- as.vector( outer( keyN$uq_Play[intCtr, ], keyM$uq_Play[intCtr, ] ) )
    }
 
    # Sum outcomes for matrix cross product (column values for aTest)
    aScore <- as.vector(outer(keyN$uq_Res, keyM$uq_Res, FUN="+"))
    
    # Find and sort the unique scores
    uqRes <- sort(unique(aScore))

    # Convert the full aTest in to unique hands with values by column
    keyRow <- 1:length(aScore)
    keyCol <- match(aScore, uqRes)
    uq_Play <- sapply(unique(sort(keyCol)), 
                      FUN=function(x) { rowSums(aTest[, keyRow[keyCol==x], drop=FALSE]) } 
                      )
    
    list(uq_Play=uq_Play, uq_Res=uqRes, cWeight=keyN$cWeight)
        
}


# Run the aTest process on the line-by-line
create_Sapply02_mnPlay <- function(keyN, keyM) {
 
    # Sum outcomes for matrix cross product (column values for aTest)
    aScore <- as.vector(outer(keyN$uq_Res, keyM$uq_Res, FUN="+"))
    
    # Find and sort the unique scores
    uqRes <- sort(unique(aScore))
    uq_Sapply <- matrix(data=0, nrow=nrow(keyN$uq_Play), ncol=length(uqRes))
    
    # Find the key rows and columns, as well as who maps to who
    keyRow <- 1:length(aScore)
    keyCol <- match(aScore, uqRes)
    keyMap <- lapply(unique(sort(keyCol)), FUN=function(x) { keyRow[keyCol==x] } )
    
    # Matrix multiply by "flavor" (unique rows)
    for (intCtr in 1:nrow(keyN$uq_Play)) {
        keyVec <- as.vector( outer( keyN$uq_Play[intCtr, ], keyM$uq_Play[intCtr, ] ) )
        uq_Sapply[intCtr, ] <- 
            sapply( keyMap, FUN=function(x) { sum(keyVec[x]) } )
    }
 
    list(uq_Play=uq_Sapply, uq_Res=uqRes, cWeight=keyN$cWeight)
        
}

The methodologies are benchmarked, with results cached since running 5-10 times for each starts to take some time:

# Create JB96_uq007 for reference
startTime <- proc.time()
jb96_uq007 <- create_mnPlay(keyN=jb96_uq004, keyM=jb96_uq003)
proc.time() - startTime
##    user  system elapsed 
##   27.55    0.04   27.91
# Explore the JB 96 2x2 case
microbenchmark(sap01=(jb96_test01_uq004 <- create_Sapply01_mnPlay(keyN=jb96_uq002, keyM=jb96_uq002)),
               sap02=(jb96_test02_uq004 <- create_Sapply02_mnPlay(keyN=jb96_uq002, keyM=jb96_uq002)),
               times=10L
               )
## Unit: milliseconds
##   expr      min      lq     mean   median       uq      max neval cld
##  sap01 100.0951 104.602 107.4139 106.5394 111.4320 114.1720    10  a 
##  sap02 471.2414 478.782 494.6737 491.2378 502.0267 533.9295    10   b
all.equal(jb96_uq004, jb96_test01_uq004)
## [1] TRUE
all.equal(jb96_uq004, jb96_test02_uq004)
## [1] TRUE
# Explore the JB 96 4x3 case
microbenchmark(tRes=(tempRes <- testByRes()), 
               sap01=(jb96_test01_uq007 <- create_Sapply01_mnPlay(keyN=jb96_uq004, keyM=jb96_uq003)),
               sap02=(jb96_test02_uq007 <- create_Sapply02_mnPlay(keyN=jb96_uq004, keyM=jb96_uq003)),
               times=5L
               )
## Unit: milliseconds
##   expr       min        lq      mean   median        uq      max neval cld
##   tRes  947.1779  960.9695  987.9195  972.066  976.9116 1082.472     5 a  
##  sap01 1522.3668 1529.1656 1547.0828 1529.889 1556.7866 1597.206     5  b 
##  sap02 2414.6411 2442.9209 2489.6417 2494.403 2541.7137 2554.529     5   c
all.equal(jb96_uq007, jb96_test01_uq007)
## [1] TRUE
all.equal(jb96_uq007, jb96_test02_uq007)
## [1] TRUE
all.equal(jb96_uq007$uq_Play, tempRes)
## [1] TRUE
# Explore the JB 96 5x5 case (not cleaned)
dataOne <- jb96_uq005
dataTwo <- jb96_uq005
colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
colRes_uq <- sort(unique(as.vector(colRes)))
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))

microbenchmark(tRes=(tempRes <- testByRes()), 
               sap02=(jb96_test02_uq010 <- create_Sapply02_mnPlay(keyN=jb96_uq005, keyM=jb96_uq005)),
               times=5L
               )
## Unit: seconds
##   expr       min       lq      mean    median       uq       max neval cld
##   tRes 10.215711 10.25875 10.304460 10.265196 10.33587 10.446773     5   b
##  sap02  8.990372  9.00882  9.066402  9.075197  9.10341  9.154213     5  a
all.equal(jb96_test02_uq010$uq_Play, tempRes)
## [1] TRUE
# Explore the JB 96 5x5 case (cleaned)
dataOne <- clean_NPlay(nPlayInput=jb96_uq005)
## 
## 
## Contributions to SUM: -59,268.7 -59,269.5 (100%) 0.8 (0%)
## Contributions to SUM-SQUARED: 355,801,979 355,800,279 (100%) 1,700 (0%)
## 
## Means Assuming All, Large, Small: -0.022805 -0.022805 1300.044
## Variances Assuming All, Large, Small: 136.9012 136.9005 1,086,441 
## 
## Means shifted from/to: -0.022805 -0.022805
## E[X^2] shifted from/to: 136.902 136.901
dataTwo <- clean_NPlay(nPlayInput=jb96_uq005)
## 
## 
## Contributions to SUM: -59,268.7 -59,269.5 (100%) 0.8 (0%)
## Contributions to SUM-SQUARED: 355,801,979 355,800,279 (100%) 1,700 (0%)
## 
## Means Assuming All, Large, Small: -0.022805 -0.022805 1300.044
## Variances Assuming All, Large, Small: 136.9012 136.9005 1,086,441 
## 
## Means shifted from/to: -0.022805 -0.022805
## E[X^2] shifted from/to: 136.902 136.901
colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
colRes_uq <- sort(unique(as.vector(colRes)))
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))

microbenchmark(tRes=(tempRes <- testByRes()), 
               sap02=(jb96_test02_uq010_cl <- create_Sapply02_mnPlay(keyN=dataOne, keyM=dataTwo)),
               times=5L
               )
## Unit: seconds
##   expr      min       lq     mean   median       uq      max neval cld
##   tRes 2.800481 2.828953 2.853132 2.843240 2.874086 2.918899     5  a 
##  sap02 4.586511 4.707182 4.785808 4.811403 4.903698 4.920247     5   b
all.equal(jb96_test02_uq010_cl$uq_Play, tempRes)
## [1] TRUE
# Explore the JB 96 10x5 case (cleaned)
dataOne <- clean_NPlay(nPlayInput=jb96_test02_uq010)
## 
## 
## Contributions to SUM: -118,537.4 -118,551.2 (100.01%) 13.7 (-0.01%)
## Contributions to SUM-SQUARED: 967,134,937 967,097,447 (100%) 37,490 (0%)
## 
## Means Assuming All, Large, Small: -0.04561 -0.045615 1978.338
## Variances Assuming All, Large, Small: 372.1217 372.1073 1,484,668 
## 
## Means shifted from/to: -0.04561 -0.045614
## E[X^2] shifted from/to: 372.124 372.11
dataTwo <- clean_NPlay(nPlayInput=jb96_uq005)
## 
## 
## Contributions to SUM: -59,268.7 -59,269.5 (100%) 0.8 (0%)
## Contributions to SUM-SQUARED: 355,801,979 355,800,279 (100%) 1,700 (0%)
## 
## Means Assuming All, Large, Small: -0.022805 -0.022805 1300.044
## Variances Assuming All, Large, Small: 136.9012 136.9005 1,086,441 
## 
## Means shifted from/to: -0.022805 -0.022805
## E[X^2] shifted from/to: 136.902 136.901
colRes <- outer(dataOne$uq_Res, dataTwo$uq_Res, FUN="+")
colRes_uq <- sort(unique(as.vector(colRes)))
dataOut <- matrix(data=0L, nrow=nrow(dataOne$uq_Play), ncol=length(colRes_uq))

microbenchmark(tRes=(tempRes <- testByRes()), 
               sap02=(jb96_test02_uq015_cl <- create_Sapply02_mnPlay(keyN=dataOne, keyM=dataTwo)),
               times=5L
               )
## Unit: seconds
##   expr      min       lq    mean   median       uq      max neval cld
##   tRes 10.85795 11.03593 11.0697 11.10861 11.17259 11.17342     5   b
##  sap02 10.49496 10.62467 10.6816 10.65275 10.73128 10.90436     5  a
all.equal(jb96_test02_uq015_cl$uq_Play, tempRes)
## [1] TRUE

The tRes and sap02 approaches are especially attractive since they do not hog memory (running one result at a time or one row at a time) regardless of underlying matrix sizes. An especially attractive approach seems to be:

  • Understand the potential outcomes, based on the unique outer products (FUN=“+”) of the outcome vectors that are provided as inputs
  • Approach 1 (testByRes) cycles over each of the unique potential outcomes, finds the column combinations that produce that unique potential outcome, and runs the full sum-product of the column multiplication
  • Approach 2 (create_Sapply02_mnPlay) cycles over each of the flavors (rows), runs the full outer product, and then sums subsets to the appropriate unique potential outcomes for that flavor

For the modest sized m/n, testByRes appears to be faster, though there may be benefits to running by row as the m/n become larger. Combined with the cleaning approach for very rare hands, this shows significant promise for expanding the n-play outcome vectors without overly taxing memory and/or CPU.

In particular, timing for expanding out to larger N-Play is so far manageable. The process includes:

  • Clean the underlying n-play data file of any very small probabilities (with the EV and likelihood combined instead in to a single record)
  • Find the outer-product (FUN=“+”) of the potential outcomes
  • Gather the resulting probabilities either “by result” or “by row”

Analysis of Individual Games

Next, an individual game is defined and then run through the key components of the process to get the N-play data:

genGame <- function(hnd2Score, useGameName, cWeight=cardWeight) {

    gameIndex <- seq_len(nrow(hnd2Score)) - 1
    gameList <- simGame(h2S=hnd2Score)
    findMeanVar(useList=gameList, useName=useGameName)  # Mean and variance on deal
    gameHolds <- findHolds(idxKeep=gameList$tempSmallMax[2, ])  # Cards held

    # Simulate for percentiles
    set.seed(2017010108)
    gameSim <- simPercentile(keyList=gameList, useName=useGameName)

    # Investigate the pattern of initial deal EV
    data.frame(rndScore=round(rep(gameList$tempSmallMax[1, ], times=cWeight), 0)) %>%
        group_by(rndScore) %>%
        summarize(ct=n(), per=round(choose(52, 5)/ct, 1)) %>%
        print.data.frame()

    # Assess JB 95 game for variance on the deal
    gameDraws <- simDrawVar(aT=aType, mtxI=mtxIndices, useHolds=gameList$tempSmallMax[2, ],
                            cardI=cardIndex, cardW=cWeight, startT=startTime, 
                            grTitle="EV Draw Simulation Results", allOut=FALSE
                            )
    calcMeanVar(tempDraws=gameDraws, hnd2Score=hnd2Score, mainName=useGameName)

    # Find the unique lists associated to the game, with key statistics
    gameUniqueList <- indMeanVar(hnd2Score=hnd2Score, listDraws=gameDraws, 
                                 useName=useGameName, allOut=TRUE
                                 )
    graphMeanVar(useFrame=gameUniqueList$uqFrame, useName=useGameName)  # EV/variance graphed by hold
    assessFlavor(uqList=gameUniqueList)  # Table of EV/variance by "hold-N"
    totOutcomes(keyList=gameUniqueList, useName=useGameName)  # Overall game return table

    # Create straight-up as 1/3/5/10-play
    game_01Play <- assessNPlay(keyList=gameUniqueList, nPlay=1L)
    game_03Play <- assessNPlay(keyList=gameUniqueList, nPlay=3L)
    game_05Play <- assessNPlay(keyList=gameUniqueList, nPlay=5L)
    game_10Play <- assessNPlay(keyList=gameUniqueList, nPlay=10L)

    # Simulate 16,000 hands of 10-play and 5-play
    set.seed(1701010756)
    game_10Sim <- sim_NPlay(keyFrame=game_10Play$out10Play, useName=useGameName, 
                            nPlay=10, nHands=16000, nSim=2000
                            )
    set.seed(101201708)
    game_05Sim <- sim_NPlay(keyFrame=game_05Play$dfOutcome, useName=useGameName, 
                            nPlay=5, nHands=16000, nSim=2000
                            )

    # Try the more efficient N-play approach, extended with sapply02
    game_uq001 <- get_uq1Play(keyList=gameUniqueList)
    game_uq002 <- create_Sapply02_mnPlay(keyN=game_uq001, keyM=game_uq001)
    game_uq003 <- create_Sapply02_mnPlay(keyN=game_uq002, keyM=game_uq001)
    game_uq005 <- create_Sapply02_mnPlay(keyN=game_uq003, keyM=game_uq002)
    game_uq010 <- create_Sapply02_mnPlay(keyN=game_uq005, keyM=game_uq005)

    print(all.equal(game_10Play$out10Play$nOutcome, game_uq010$uq_Res))
    print(all.equal(game_10Play$out10Play$wts, colSums(game_uq010$cWeight * game_uq010$uq_Play)))

    # Return a large list of key data
    list(gameName=useGameName,
         gameList=gameList,
         gameHolds=gameHolds,
         gameSim=gameSim,
         gameDraws=gameDraws,
         gameUniqueList=gameUniqueList,
         game_01Play=game_01Play,
         game_03Play=game_03Play,
         game_05Play=game_05Play,
         game_10Play=game_10Play,
         game_10Sim=game_10Sim,
         game_05Sim=game_05Sim,
         game_uq001=game_uq001,
         game_uq002=game_uq002,
         game_uq003=game_uq003,
         game_uq005=game_uq005,
         game_uq010=game_uq010
         )
    
}

The data are run for the JB 95 game, with holds extracted and compared to JB 96:

# Define the paytable and simulate the holds (JB 95)
startTime <- proc.time()
jb95hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                 799, 49,  8,  4,  3, 
                                                   2,  1,  0,  0,  0, 
                                                   0, -1, -1, 24, 24, 
                                                  24, 24, 24, 24, 24, 
                                                  24, 24, 24, 24, 24
                                            )
                        )
jb95GameData <- genGame(hnd2Score=jb95hnd2Score, useGameName="JB 95")
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6651  -1.0000 799.0000 
## 
## # A tibble: 10 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  337920
## 3        1  123552
## 4        2   54912
## 5        3   10200
## 6        4    5108
## 7        8    3744
## 8       24     624
## 9       49      36
## 10     799       4
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.0000 -0.9375 -0.8750 -0.6651 -0.6250 24.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9107 -0.8138 -0.8138 -0.6651 -0.6624  3.2650 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8122 -0.7731 -0.6898 -0.6651 -0.6506  0.5143 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7196 -0.7068 -0.7068 -0.6651 -0.5687 -0.5602 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6444  -0.5205  -0.1763  -0.0155  -0.0426 799.0000 
## 
## [1] 0.9844981

## [1] "Game JB 95:  Return: 0.9845 and Variance on Deal: 1.946"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -70.800 -23.660  -9.799  -7.074   5.587 792.100 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -73.28  -29.83  -20.05  -21.14  -10.71   13.54 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -106.500  -38.300  -17.860  -13.470    3.749  853.400 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -112.9000  -46.1600  -30.8800  -32.8300  -16.8500    0.5365 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -166.100  -62.780  -33.520  -30.410   -4.351  807.200 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -172.20  -74.77  -51.23  -53.82  -29.28    2.11 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -268.10 -109.80  -67.65  -58.96  -21.13  863.70 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -277.700 -122.400  -86.150  -89.890  -53.000    3.302 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -434.20 -190.10 -131.40 -123.10  -69.52  833.50 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -440.8000 -209.0000 -156.1000 -158.7000 -105.0000   -0.5941 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -700.6  -345.9  -263.8  -250.8  -181.1   986.6 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -723.2000 -367.9000 -289.8000 -291.7000 -215.9000   -0.6603 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -992.4  -525.4  -413.1  -391.4  -305.7  1357.0 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -995.700 -546.600 -439.000 -441.300 -336.300   -2.219 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1334.0  -798.1  -643.4  -616.5  -495.6  1458.0 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1334.00  -822.30  -672.60  -673.00  -538.20   -26.35

##    rndScore      ct      per
## 1        -1  899100      2.9
## 2         0 1158420      2.2
## 3         1  341496      7.6
## 4         2  124500     20.9
## 5         3   65148     39.9
## 6         4    4952    524.8
## 7         8    3744    694.2
## 8        17     752   3456.1
## 9        18      52  49980.0
## 10       19     132  19689.1
## 11       24     624   4165.0
## 12       49      36  72193.3
## 13      799       4 649740.0
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
## 
##  Summary of JB 95 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2210   18052    9465   81990   18897    3845 
## 
##      1 
## 134459 
## 
## [1] "JB 95: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6444  -0.5205  -0.1763  -0.0155  -0.0426 799.0000 
## [1] "Overall Return: 0.984498"
## 
## [1] "JB 95: Variances (Deal, Draw)"
## [1] "Deal Variance: 1.946"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     2.579     3.549    17.550     4.428 13300.000

## 
## 
## This will assess the JB 95 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 
## 4 8 5 
## 5 4 6 
## 6 3 7 
## 7 2 8 
## 8 1 9 
## 9 0 10 11 12 13 
## 10 24 16 17 18 19 20 21 22 23 24 25 26 27 
## [1] 1269
##  num [1:1269, 1:10] 0 0 0 0 33 ...
##      rSum  ct
## 1       1   6
## 2      47  34
## 3    1081 104
## 4   16215  95
## 5  178365 155
## 6 1533939 875
##  chr [1:134459] "0-0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-0-1" ...
##  chr [1:1269] "0-0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0-0" ...
##  int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
##  num [1:1269(1d)] 624 3744 54912 123552 96 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1269] "1" "2" "3" "4" ...

## [1] 0.9844981
## [1] 17.54967
##    scoreType    occPer   contRet    occFreq
## 2        799 40170.000  0.019891 0.00002490
## 3         49  9326.000  0.005254 0.00010723
## 10        24   423.200  0.056710 0.00236293
## 4          8    86.850  0.092112 0.01151397
## 5          4    91.810  0.043570 0.01089239
## 6          3    89.040  0.033692 0.01123055
## 7          2    13.430  0.148930 0.07446523
## 8          1     7.734  0.129303 0.12930324
## 9          0     4.648  0.000000 0.21513533
## 1         -1     1.835 -0.544964 0.54496425
## 
## Printed table suggests JB 95 mean return: 0.984498 and overall variance: 19.49883 
## 
## List of 1
##  $ : int [1:10] 1 2 3 4 5 6 7 8 9 10
## 
##    1 
## 1269 
##  int [1:10, 1] 1 2 3 4 5 6 7 8 9 10
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 10 
## 
## Moving to assess the: 10 rows of outcomes
## 
## 
## Mean: 0.9844981      Variance: 19.49564 
## List of 3
##  $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1269 
##  int [1:1000, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 114 
## 
## Moving to assess the: 114 rows of outcomes
##  num [1:1269, 1:3, 1:6] 0 0 0 0 0 ...
##  num [1:1269, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## 
## 
## Mean: 0.9844981      Variance: 70.16269 
## List of 5
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1269 
##  int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 406 
## 
## Moving to assess the: 406 rows of outcomes
##  num [1:1269, 1:45] 0 0 0 0 0.000157 ...
##  num [1:1269] 0 0 0 0 0.00157 ...
## [1] 100
##  num [1:1269, 1:250] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1269, 1:270] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1269] 0 0 0 0 0 ...
## [1] 300
##  num [1:1269, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## 
## 
## Mean: 0.9844981      Variance: 136.3974 
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1269 
##  int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 406 
## 
## Moving to assess the: 406 rows of outcomes
##  num [1:1269, 1:45] 0 0 0 0 0.000157 ...
##  num [1:1269] 0 0 0 0 0.00157 ...
## [1] 100
##  num [1:1269, 1:250] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1269, 1:270] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1269] 0 0 0 0 0 ...
## [1] 300
##  num [1:1269, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1269] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
## 
## 
## Mean: 0.9844981      Variance: 370.0931 
## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.446% with total variance (sd as % of total bet): 5,647,675 ( 1.49% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0427 -0.0366 -0.0324 -0.0251 -0.0173 -0.0071  0.0018  0.0101  0.0334

## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.4% with total variance (sd as % of total bet): 2,128,016 ( 1.82% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0509 -0.0433 -0.0377 -0.0280 -0.0175 -0.0058  0.0073  0.0158  0.0370

##  num [1:1269, 1:10] 0 0 0 0 0.702 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:10] "" "" "" "" ...
## [1] TRUE
## [1] TRUE
proc.time() - startTime
##    user  system elapsed 
##  119.31   13.70  133.91
# Extract JB 95 holds from JB 95 game data, and compare with JB 96
jb95Holds <- jb95GameData$gameHolds
jb96_vs_jb95Holds <- diffHolds(jb96Holds, jb95Holds)
sum(jb96_vs_jb95Holds)
## [1] 627
if (sum(jb96_vs_jb95Holds) > 0) { 
    cbind(cardSmall[jb96_vs_jb95Holds, ], 
          jb96Holds[jb96_vs_jb95Holds, ], 
          jb95Holds[jb96_vs_jb95Holds, ]
          )[sort(sample(1:sum(jb96_vs_jb95Holds), 20)), ]
}
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
##  [1,]    1    5   10   12   23    1    5   10   12    NA     1    NA    10
##  [2,]    1    7   10   12   23    1    7   10   12    NA     1    NA    10
##  [3,]    1    4    9   23   25   NA   NA   NA   23    25     1    NA    NA
##  [4,]    1    4   13   24   25   NA   NA   NA   24    25     1    NA    13
##  [5,]    1    6   10   13   25    1    6   10   13    NA     1    NA    10
##  [6,]    1    8   10   11   26    1    8   10   11    NA     1    NA    10
##  [7,]    2   10   13   16   20   NA   10   13   NA    NA    NA    NA    13
##  [8,]    2   10   13   17   31   NA   10   13   NA    NA    NA    NA    13
##  [9,]    2   10   13   20   21   NA   10   13   NA    NA    NA    NA    13
## [10,]    7   10   13   15   34   NA   10   13   NA    NA    NA    NA    13
## [11,]   10   11   15   34   52   10   11   NA   NA    NA    NA    11    NA
## [12,]    3   10   13   17   34   NA   10   13   NA    NA    NA    NA    13
## [13,]    3    5    6   23   24    3    5    6   NA    NA    NA    NA    NA
## [14,]    3    8   23   24   39   NA   NA   23   24    NA    NA    NA    NA
## [15,]    4    5    6   25   26    4    5    6   NA    NA    NA    NA    NA
## [16,]    4    6    7   25   39    4    6    7   NA    NA    NA    NA    NA
## [17,]   10   11   17   26   34   10   11   NA   NA    NA    NA    11    NA
## [18,]    5    7    8   25   39    5    7    8   NA    NA    NA    NA    NA
## [19,]    8   10   12   18   37    8   10   12   NA    NA    NA    NA    12
## [20,]   10   11   19   35   52   10   11   NA   NA    NA    NA    11    NA
##       [,14] [,15]
##  [1,]    12    NA
##  [2,]    12    NA
##  [3,]    NA    25
##  [4,]    24    25
##  [5,]    13    NA
##  [6,]    11    NA
##  [7,]    NA    NA
##  [8,]    NA    NA
##  [9,]    NA    NA
## [10,]    NA    NA
## [11,]    NA    52
## [12,]    NA    NA
## [13,]    23    24
## [14,]    24    39
## [15,]    25    26
## [16,]    25    39
## [17,]    26    NA
## [18,]    25    39
## [19,]    NA    37
## [20,]    NA    52

The data are run for the BP 75 game, with holds extracted and compared to BP 85:

# Define the paytable and simulate the holds (BP 75)
startTime <- proc.time()
bp75hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                 799, 49,  6,  4,  3, 
                                                   2,  1,  0,  0,  0, 
                                                   0, -1, -1, 79, 79, 
                                                  79, 39, 39, 39, 39, 
                                                  24, 24, 24, 24, 24
                                            )
                        )
bp75GameData <- genGame(hnd2Score=bp75hnd2Score, useGameName="BP 75")
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6661  -1.0000 799.0000 
## 
## # A tibble: 12 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  337920
## 3        1  123552
## 4        2   54912
## 5        3   10200
## 6        4    5108
## 7        6    3744
## 8       24     432
## 9       39     144
## 10      49      36
## 11      79      48
## 12     799       4
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.0000 -0.9375 -0.8750 -0.6661 -0.6250 79.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9107 -0.8138 -0.8138 -0.6661 -0.6624  5.3880 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8141 -0.7741 -0.6916 -0.6661 -0.6524  0.6294 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7193 -0.7093 -0.7093 -0.6661 -0.5712 -0.5609 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6447  -0.5199  -0.1967  -0.0198  -0.0426 799.0000 
## 
## [1] 0.9801469

## [1] "Game BP 75:  Return: 0.98015 and Variance on Deal: 2.08"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -70.000 -26.620 -13.060  -9.365   3.065 790.600 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -72.60  -32.01  -22.07  -22.93  -12.22   11.62 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -112.5000  -42.9500  -23.5000  -17.4900    0.3269  845.9000 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -119.4000  -51.5400  -34.9700  -36.4700  -19.5400    0.5162 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -176.40  -74.06  -44.92  -39.60  -12.68  795.80 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -177.200  -83.600  -60.250  -61.680  -35.680    1.259 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -296.00 -130.10  -86.67  -76.16  -36.33  837.40 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -296.00 -141.60 -103.90 -105.70  -68.06    3.18 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -471.9  -229.6  -168.8  -158.8  -102.0   788.2 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -472.500 -247.000 -190.800 -192.400 -134.400   -2.658 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -750.8  -424.0  -341.0  -321.9  -245.6   945.5 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -762.700 -442.400 -361.700 -359.100 -277.800   -4.474 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1109.0  -642.8  -525.9  -501.3  -405.4  1237.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1148.000  -663.000  -549.000  -546.500  -438.000    -4.912 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1565.0  -984.6  -814.7  -790.8  -654.1  1351.0 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1565.0 -1005.0  -849.3  -839.5  -692.6   -47.5

##    rndScore      ct      per
## 1        -1  911328      2.9
## 2         0 1146192      2.3
## 3         1  465048      5.6
## 4         2     948   2741.5
## 5         3   48252     53.9
## 6         4   17624    147.5
## 7         6    7968    326.2
## 8        17     752   3456.1
## 9        18      52  49980.0
## 10       19     132  19689.1
## 11       24     432   6016.1
## 12       39     144  18048.3
## 13       49      36  72193.3
## 14       79      48  54145.0
## 15      799       4 649740.0
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
## 
##  Summary of BP 75 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2210   18087    9462   81940   18915    3845 
## 
##      1 
## 134459 
## 
## [1] "BP 75: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6447  -0.5199  -0.1967  -0.0198  -0.0426 799.0000 
## [1] "Overall Return: 0.980147"
## 
## [1] "BP 75: Variances (Deal, Draw)"
## [1] "Deal Variance: 2.0801"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     2.260     3.256    18.670     5.831 13300.000

## 
## 
## This will assess the BP 75 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 
## 4 6 5 
## 5 4 6 
## 6 3 7 
## 7 2 8 
## 8 1 9 
## 9 0 10 11 12 13 
## 10 79 16 17 18 
## 11 39 19 20 21 22 
## 12 24 23 24 25 26 27 
## [1] 1647
##  num [1:1647, 1:12] 0 0 0 0 0 0 0 0 33 0 ...
##      rSum  ct
## 1       1   8
## 2      47  34
## 3    1081 106
## 4   16215  95
## 5  178365 451
## 6 1533939 953
##  chr [1:134459] "0-0-0-0-0-0-0-0-0-1-0-0" ...
##  chr [1:1647] "0-0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-0-0-1-0" ...
##  int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
##  num [1:1647(1d)] 48 144 432 3744 4224 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1647] "1" "2" "3" "4" ...

## [1] 0.9801469
## [1] 18.6737
##    scoreType    occPer   contRet    occFreq
## 2        799 40230.000  0.019859 0.00002485
## 10        79  5106.000  0.015471 0.00019584
## 3         49  9346.000  0.005243 0.00010699
## 11        39  1897.000  0.020563 0.00052725
## 12        24   610.100  0.039339 0.00163914
## 4          6    86.870  0.069069 0.01151142
## 5          4    91.880  0.043535 0.01088366
## 6          3    88.740  0.033805 0.01126847
## 7          2    13.430  0.148873 0.07443631
## 8          1     7.736  0.129263 0.12926285
## 9          0     4.645  0.000000 0.21527153
## 1         -1     1.835 -0.544872 0.54487169
## 
## Printed table suggests BP 75 mean return: 0.980148 and overall variance: 20.75093 
## 
## List of 1
##  $ : int [1:12] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:12, 1] 1 2 3 4 5 6 7 8 9 10 ...
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 12 
## 
## Moving to assess the: 12 rows of outcomes
## 
## 
## Mean: 0.9801469      Variance: 20.75378 
## List of 3
##  $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1728] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:1728, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 194 
## 
## Moving to assess the: 194 rows of outcomes
##  num [1:1647, 1:3, 1:6] 0 0 0 1 0.0611 ...
##  num [1:1647, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## 
## 
## Mean: 0.9801469      Variance: 74.74178 
## List of 5
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 716 
## 
## Moving to assess the: 716 rows of outcomes
##  num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 ...
## [1] 100
##  num [1:1647, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:1647, 1:360] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1647, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1647, 1:10] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## 
## 
## Mean: 0.9801469      Variance: 145.3704 
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1647 
##  int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 716 
## 
## Moving to assess the: 716 rows of outcomes
##  num [1:1647, 1:1230] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 ...
## [1] 100
##  num [1:1647, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1647, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:1647, 1:360] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1647, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1647, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1647, 1:10] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1647] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## 
## 
## Mean: 0.9801469      Variance: 394.7444 
## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.009% with total variance (sd as % of total bet): 6,005,956 ( 1.53% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0487 -0.0418 -0.0377 -0.0299 -0.0215 -0.0114 -0.0022  0.0061  0.0303

## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.962% with total variance (sd as % of total bet): 2,289,651 ( 1.89% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0568 -0.0491 -0.0439 -0.0326 -0.0218 -0.0095  0.0037  0.0124  0.0360

##  num [1:1647, 1:12] 0 0 0 0 0 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:12] "" "" "" "" ...
## [1] TRUE
## [1] TRUE
proc.time() - startTime
##    user  system elapsed 
##  159.51   17.80  177.95
# Extract BP 75 holds from BP 75 game data, and compare with BP 85
bp75Holds <- bp75GameData$gameHolds
bp85_vs_bp75Holds <- diffHolds(bp85Holds, bp75Holds)
sum(bp85_vs_bp75Holds)
## [1] 47
if (sum(bp85_vs_bp75Holds) > 0) { 
    cbind(cardSmall[bp85_vs_bp75Holds, ], 
          bp85Holds[bp85_vs_bp75Holds, ], 
          bp75Holds[bp85_vs_bp75Holds, ]
          )[sort(sample(1:sum(bp85_vs_bp75Holds), 20)), ]
}
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
##  [1,]    9   10   11   22   25    9   NA   NA   22    NA     9    10    11
##  [2,]    9   10   12   22   24    9   NA   NA   22    NA     9    10    12
##  [3,]    9   10   12   22   37    9   NA   NA   22    NA     9    10    12
##  [4,]    9   11   22   36   38    9   NA   22   NA    NA     9    11    NA
##  [5,]    9   22   37   49   51    9   22   NA   NA    NA     9    NA    37
##  [6,]    9   10   22   37   51    9   NA   22   NA    NA     9    10    NA
##  [7,]    9   11   22   36   51    9   NA   22   NA    NA     9    11    NA
##  [8,]    9   10   11   23   25   NA   10   NA   23    NA     9    10    11
##  [9,]   10   11   23   35   38   10   NA   23   NA    NA    10    11    NA
## [10,]   10   23   35   50   51   10   23   NA   NA    NA    10    NA    35
## [11,]    9   10   23   24   38   NA   10   23   NA    NA     9    10    NA
## [12,]    9   10   23   25   37   NA   10   23   NA    NA     9    10    NA
## [13,]    9   10   23   37   51   NA   10   23   NA    NA     9    10    NA
## [14,]   10   11   23   35   51   10   NA   23   NA    NA    10    11    NA
## [15,]   10   12   23   35   50   10   NA   23   NA    NA    10    12    NA
## [16,]    2    3    4   14   36   NA   NA   NA   14    NA     2     3     4
## [17,]    2    3    5   14   36   NA   NA   NA   14    NA     2     3     5
## [18,]    4    5    7   21   37   NA   NA   NA   NA    37     4     5     7
## [19,]    7    8   11   23   39   NA   NA   11   NA    39     7     8    11
## [20,]    7   10   11   21   39   NA   NA   11   NA    39     7    10    11
##       [,14] [,15]
##  [1,]    NA    25
##  [2,]    NA    24
##  [3,]    NA    37
##  [4,]    36    38
##  [5,]    49    51
##  [6,]    37    51
##  [7,]    36    51
##  [8,]    NA    25
##  [9,]    35    38
## [10,]    50    51
## [11,]    24    38
## [12,]    25    37
## [13,]    37    51
## [14,]    35    51
## [15,]    35    50
## [16,]    NA    NA
## [17,]    NA    NA
## [18,]    NA    NA
## [19,]    NA    NA
## [20,]    NA    NA

The data are run for the DDB 96 game, with the pay table having been previously created above:

# Use the previously existing pay table (print for reference) and simulate DDB 96
startTime <- proc.time()
ddb96hnd2Score
##    idx val
## 1    0  -1
## 2    1 799
## 3    2  49
## 4    3   8
## 5    4   5
## 6    5   3
## 7    6   2
## 8    7   0
## 9    8   0
## 10   9   0
## 11  10   0
## 12  11   0
## 13  12  -1
## 14  13  -1
## 15  14 399
## 16  15 159
## 17  16 159
## 18  17 159
## 19  18 159
## 20  19  79
## 21  20  79
## 22  21  49
## 23  22  49
## 24  23  49
## 25  24  49
## 26  25  49
ddb96GameData <- genGame(hnd2Score=ddb96hnd2Score, useGameName="DDB 96")
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6988  -1.0000 799.0000 
## 
## # A tibble: 11 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  461472
## 3        2   54912
## 4        3   10200
## 5        5    5108
## 6        8    3744
## 7       49     468
## 8       79     108
## 9      159      72
## 10     399      12
## 11     799       4
## 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -0.9375  -0.8750  -0.6988  -0.7500 219.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9337 -0.8367 -0.8367 -0.6988 -0.6854 11.2200 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8501 -0.8094 -0.7277 -0.6988 -0.6885  0.8302 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7473 -0.7456 -0.7430 -0.6988 -0.6075 -0.5743 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6770  -0.5414  -0.2668  -0.0102   0.1489 799.0000 
## 
## [1] 0.9898078

## [1] "Game DDB 96:  Return: 0.98981 and Variance on Deal: 4.809"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -81.850 -30.000 -13.370  -5.006   9.338 797.900 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -84.16  -38.14  -25.88  -26.91  -14.04   19.88 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -129.400  -47.810  -22.160   -7.103   13.500  867.200 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -140.00  -60.04  -38.39  -41.59  -21.12    1.82 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -205.30  -78.33  -37.62  -21.65   11.32  858.90 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -205.900  -95.590  -64.470  -67.480  -34.210    5.765 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -343.60 -128.40  -62.35  -36.31   21.62 1079.00 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -343.600 -151.300 -101.600 -106.900  -55.640    4.366 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -524.500 -209.300 -113.000  -84.580    3.117  975.300 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -531.600 -245.300 -171.400 -177.400  -96.770    0.078 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -812.20 -357.50 -205.90 -170.20  -27.74 1458.00 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -827.400 -406.800 -287.900 -291.200 -160.200    3.162 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1108.00  -512.40  -308.10  -263.10   -58.35  1602.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1123.000  -576.000  -403.300  -411.600  -239.800     4.502 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1687.0  -711.4  -436.7  -406.3  -152.1  2138.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1715.000  -794.000  -560.800  -579.900  -349.900    -1.452

##    rndScore      ct      per
## 1        -1  924432      2.8
## 2         0 1384716      1.9
## 3         1  213276     12.2
## 4         2     144  18048.3
## 5         3   11184    232.4
## 6         4   38016     68.4
## 7         5    4952    524.8
## 8         6    5760    451.2
## 9         7    6912    376.0
## 10        8    3456    752.0
## 11       11    1992   1304.7
## 12       12    2520   1031.3
## 13       17     608   4274.6
## 14       18     144  18048.3
## 15       19     184  14124.8
## 16       49     468   5553.3
## 17       99     108  24064.4
## 18      159      36  72193.3
## 19      220      36  72193.3
## 20      399      12 216580.0
## 21      799       4 649740.0
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
## 
##  Summary of DDB 96 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2150   19685    9757   72889   27544    2434 
## 
##      1 
## 134459 
## 
## [1] "DDB 96: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6770  -0.5414  -0.2668  -0.0102   0.1489 799.0000 
## [1] "Overall Return: 0.989808"
## 
## [1] "DDB 96: Variances (Deal, Draw)"
## [1] "Deal Variance: 4.809"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     5.080     8.414    37.180    20.000 13290.000

## 
## 
## This will assess the DDB 96 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 23 24 25 26 27 
## 4 8 5 
## 5 5 6 
## 6 3 7 
## 7 2 8 
## 8 0 9 10 11 12 13 
## 9 399 16 
## 10 159 17 18 19 20 
## 11 79 21 22 
## [1] 1260
##  num [1:1260, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##      rSum  ct
## 1       1   7
## 2      47  38
## 3    1081 118
## 4   16215  94
## 5  178365 507
## 6 1533939 496
##  chr [1:134459] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-1-0-0" ...
##  chr [1:1260] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-12-35-0" ...
##  int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
##  num [1:1260(1d)] 12 36 36 108 468 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1260] "1" "2" "3" "4" ...

## [1] 0.9898078
## [1] 37.17596
##    scoreType    occPer   contRet    occFreq
## 2        799 40800.000  0.019584 0.00002451
## 9        399 16240.000  0.024574 0.00006159
## 10       159  3157.000  0.050367 0.00031678
## 11        79  2601.000  0.030368 0.00038441
## 3         49   574.800  0.085249 0.00173978
## 4          8    92.080  0.086880 0.01086000
## 5          5    88.040  0.056793 0.01135853
## 6          3    78.330  0.038299 0.01276626
## 7          2    13.290  0.150530 0.07526513
## 8          0     2.991  0.000000 0.33438608
## 1         -1     1.809 -0.552837 0.55283693
## 
## Printed table suggests DDB 96 mean return: 0.989807 and overall variance: 41.98492 
## 
## List of 1
##  $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1260 
##  int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 11 
## 
## Moving to assess the: 11 rows of outcomes
## 
## 
## Mean: 0.9898078      Variance: 41.98498 
## List of 3
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1260 
##  int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 200 
## 
## Moving to assess the: 200 rows of outcomes
##  num [1:1260, 1:3, 1:3] 0 0 0 0 0 ...
##  num [1:1260, 1:3] 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 ...
## [1] 100
##  num [1:1260, 1:3, 1] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260, 1] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## 
## 
## Mean: 0.9898078      Variance: 154.8091 
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1260 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1041 
## 
## Moving to assess the: 1041 rows of outcomes
##  num [1:1260, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1260, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1260, 1:10] 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 ...
## [1] 300
##  num [1:1260, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1260, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1260, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:1260, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
##  num [1:1260, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.9898078      Variance: 306.1054 
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1260 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1041 
## 
## Moving to assess the: 1041 rows of outcomes
##  num [1:1260, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1260, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1260, 1:10] 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 ...
## [1] 300
##  num [1:1260, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1260, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1260, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:1260, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:1260, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
##  num [1:1260, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1260] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.9898078      Variance: 852.662 
## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.981% with total variance (sd as % of total bet): 13,247,804 ( 2.27% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0558 -0.0448 -0.0372 -0.0259 -0.0120  0.0037  0.0191  0.0295  0.0505

## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.9% with total variance (sd as % of total bet): 4,951,298 ( 2.78% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0699 -0.0558 -0.0460 -0.0297 -0.0124  0.0066  0.0248  0.0342  0.0661

##  num [1:1260, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:11] "" "" "" "" ...
## [1] TRUE
## [1] TRUE
proc.time() - startTime
##    user  system elapsed 
##  169.93   20.16  191.17

Next, a function is written to explore 1/3/5/10 data for a game of choice:

graphGameFull <- function(simPct, simGraph, gName) {

    nSims <- nrow(simPct) - 2
    nDealGraph <- simPct[2, simGraph]
    
    par(mfcol=c(1, 2))

    plot(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[1]], col="red", cex=0.4,
         xlab="Percentile", ylab="Return", 
         main=paste0(nDealGraph[1], " Deals of ", gName)
        )
    points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[1]+1], col="orange", cex=0.4)
    points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[1]+2], col="blue", cex=0.4)
    points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[1]+3], col="green", cex=0.4)
    abline(h=0, v=c(0.01, 0.1, 0.5, 0.9), lty=2)
    quan01 <- quantile(simPct[-(1:2), simGraph[1]], c(0.01, 0.1, 0.5, 0.9))
    quan03 <- quantile(simPct[-(1:2), simGraph[1]+1], c(0.01, 0.1, 0.5, 0.9))
    quan05 <- quantile(simPct[-(1:2), simGraph[1]+2], c(0.01, 0.1, 0.5, 0.9))
    quan10 <- quantile(simPct[-(1:2), simGraph[1]+3], c(0.01, 0.1, 0.5, 0.9))
    legend("topleft", 
           legend=c(paste0("1-play ( ", paste(round(quan01, 3), collapse="  "), " )"), 
                    paste0("3-play ( ", paste(round(quan03, 3), collapse="  "), " )"),
                    paste0("5-play ( ", paste(round(quan05, 3), collapse="  "), " )"),
                    paste0("10-play ( ", paste(round(quan10, 3), collapse="  "), " )")
                    ), 
           col=c("red", "orange", "blue", "green"), lwd=2, pch=19, cex=0.6
           )

    plot(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[2]], col="red", cex=0.4,
         xlab="Percentile", ylab="Return", 
         main=paste0(nDealGraph[2], " Deals of ", gName)
        )
    points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[2]+1], col="orange", cex=0.4)
    points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[2]+2], col="blue", cex=0.4)
    points(x=(1:nSims)/nSims, y=simPct[-(1:2), simGraph[2]+3], col="green", cex=0.4)
    abline(h=0, v=c(0.01, 0.1, 0.5, 0.9), lty=2)
    quan01 <- quantile(simPct[-(1:2), simGraph[2]], c(0.01, 0.1, 0.5, 0.9))
    quan03 <- quantile(simPct[-(1:2), simGraph[2]+1], c(0.01, 0.1, 0.5, 0.9))
    quan05 <- quantile(simPct[-(1:2), simGraph[2]+2], c(0.01, 0.1, 0.5, 0.9))
    quan10 <- quantile(simPct[-(1:2), simGraph[2]+3], c(0.01, 0.1, 0.5, 0.9))
    legend("topleft", 
           legend=c(paste0("1-play ( ", paste(round(quan01, 3), collapse="  "), " )"), 
                    paste0("3-play ( ", paste(round(quan03, 3), collapse="  "), " )"),
                    paste0("5-play ( ", paste(round(quan05, 3), collapse="  "), " )"),
                    paste0("10-play ( ", paste(round(quan10, 3), collapse="  "), " )")
                    ), 
           col=c("red", "orange", "blue", "green"), lwd=2, pch=19, cex=0.6
           )

    par(mfcol=c(1, 1))

}


simGameFull <- function(useList, gameName, nSims=2000, 
                        nDealSim=c(1000, 2000, 4000, 8000, 16000, 24000, 32000, 40000), 
                        nDealGraph=c(4000, 32000)
                        ) {

    simGraph <- 4 * match(nDealGraph, nDealSim) - 3
    if (length(complete.cases(simGraph)) != 2) {
        stop("Error with simGameFull; need exactly *TWO* nDealGraph that are subset of nDealSim")
    }
    
    simOut <- matrix(data=0, nrow=4*length(nDealSim), ncol=nSims+2)  # nSims trials, plus nPlay and nHand

    curRow <- 1
    for (nUse in nDealSim) { 
        simOut[curRow:(curRow+3), 1] <- c(1, 3, 5, 10)
        simOut[curRow:(curRow+3), 2] <- rep(nUse, 4)

        simOut[curRow, -(1:2)] <- sim_NPlay(keyFrame=useList$game_01Play$dfOutcome, 
                                            useName=gameName, nPlay=1, nHands=nUse, nSim=nSims
                                            )
        simOut[curRow+1, -(1:2)] <- sim_NPlay(keyFrame=useList$game_03Play$dfOutcome, 
                                              useName=gameName, nPlay=3, nHands=nUse, nSim=nSims
                                              )
        simOut[curRow+2, -(1:2)] <- sim_NPlay(keyFrame=useList$game_05Play$dfOutcome, 
                                              useName=gameName, nPlay=5, nHands=nUse, nSim=nSims
                                              )
        simOut[curRow+3, -(1:2)] <- sim_NPlay(keyFrame=useList$game_10Play$out10Play, 
                                              useName=gameName, nPlay=10, nHands=nUse, nSim=nSims
                                              )

        curRow <- curRow + 4
    
    }

    simPct <- apply(simOut, 1, FUN=function(x) { c(x[1], x[2], sort(x[-(1:2)]/x[1]/x[2])) } )

    # Graph the game outputs
    graphGameFull(simPct=simPct, simGraph=simGraph, gName=gameName)
    
    # Return the simOut and simPct object
    list(simOut=simOut, simPct=simPct)
    
}

The function is run for JB 95, BP 75, and DDB 96 (1/3/5/10 play), each using 2,000 trials of 1k, 2k, 4k, 8k, 16k, 24k, 32k, 40k deals:

# Run for JB 95
startTime <- proc.time()
jb95SimGameFull <- simGameFull(useList=jb95GameData, gameName="JB 95")
## 
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.697% with total variance (sd as % of total bet): 21,485 ( 14.66% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1630 -0.1290 -0.1081 -0.0750 -0.0355  0.0080  0.0531  0.0970  0.8041

## 
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.515% with total variance (sd as % of total bet): 74,391 ( 9.09% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1373 -0.1047 -0.0877 -0.0610 -0.0323  0.0007  0.0422  0.2124  0.2923

## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.775% with total variance (sd as % of total bet): 177,990 ( 8.44% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1160 -0.0930 -0.0790 -0.0566 -0.0294  0.0040  0.0939  0.1376  0.2275

## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.415% with total variance (sd as % of total bet): 348,009 ( 5.9% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1092 -0.0854 -0.0739 -0.0533 -0.0253  0.0112  0.0526  0.0780  0.1403

## 
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.277% with total variance (sd as % of total bet): 38,699 ( 9.84% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1270 -0.0995 -0.0860 -0.0645 -0.0355 -0.0040  0.0330  0.0797  0.4045

## 
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.402% with total variance (sd as % of total bet): 144,160 ( 6.33% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1018 -0.0820 -0.0692 -0.0529 -0.0305 -0.0035  0.0719  0.1121  0.2298

## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.514% with total variance (sd as % of total bet): 279,230 ( 5.28% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0936 -0.0764 -0.0655 -0.0489 -0.0257  0.0066  0.0533  0.0714  0.1362

## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.586% with total variance (sd as % of total bet): 953,479 ( 4.88% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0821 -0.0664 -0.0582 -0.0428 -0.0210  0.0063  0.0342  0.0518  0.1016

## 
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.461% with total variance (sd as % of total bet): 73,851 ( 6.79% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1000 -0.0810 -0.0710 -0.0518 -0.0325 -0.0065  0.0438  0.1580  0.2055

## 
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.352% with total variance (sd as % of total bet): 266,656 ( 4.3% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0846 -0.0668 -0.0593 -0.0448 -0.0268  0.0027  0.0419  0.0583  0.1288

## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.449% with total variance (sd as % of total bet): 534,335 ( 3.65% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0730 -0.0612 -0.0524 -0.0406 -0.0221  0.0019  0.0273  0.0487  0.1246

## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.338% with total variance (sd as % of total bet): 1,345,000 ( 2.9% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0675 -0.0549 -0.0495 -0.0347 -0.0190 -0.0018  0.0183  0.0307  0.0519

## 
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.297% with total variance (sd as % of total bet): 146,817 ( 4.79% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0814 -0.0678 -0.0600 -0.0462 -0.0299 -0.0095  0.0598  0.0780  0.1524

## 
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.5% with total variance (sd as % of total bet): 589,350 ( 3.2% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0651 -0.0555 -0.0491 -0.0379 -0.0206  0.0011  0.0257  0.0444  0.0920

## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.385% with total variance (sd as % of total bet): 1,081,253 ( 2.6% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0592 -0.0512 -0.0452 -0.0337 -0.0198 -0.0028  0.0158  0.0298  0.0722

## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.349% with total variance (sd as % of total bet): 3,080,404 ( 2.19% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0552 -0.0469 -0.0414 -0.0303 -0.0184 -0.0054  0.0083  0.0163  0.0697

## 
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.315% with total variance (sd as % of total bet): 303,032 ( 3.44% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0694 -0.0570 -0.0517 -0.0404 -0.0271  0.0042  0.0292  0.0470  0.0857

## 
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.424% with total variance (sd as % of total bet): 1,050,588 ( 2.14% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0557 -0.0463 -0.0412 -0.0312 -0.0179 -0.0033  0.0123  0.0239  0.0404

## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.409% with total variance (sd as % of total bet): 2,183,079 ( 1.85% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0510 -0.0428 -0.0374 -0.0289 -0.0178 -0.0050  0.0075  0.0163  0.0366

## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.446% with total variance (sd as % of total bet): 5,848,164 ( 1.51% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0440 -0.0370 -0.0327 -0.0258 -0.0169 -0.0076  0.0020  0.0098  0.0345

## 
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.401% with total variance (sd as % of total bet): 458,985 ( 2.82% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0609 -0.0518 -0.0471 -0.0380 -0.0216  0.0015  0.0229  0.0367  0.0641

## 
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.527% with total variance (sd as % of total bet): 1,630,388 ( 1.77% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0484 -0.0415 -0.0365 -0.0276 -0.0159 -0.0040  0.0086  0.0165  0.0315

## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.451% with total variance (sd as % of total bet): 3,142,957 ( 1.48% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0438 -0.0372 -0.0332 -0.0255 -0.0171 -0.0071  0.0035  0.0111  0.0274

## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.422% with total variance (sd as % of total bet): 8,396,400 ( 1.21% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0389 -0.0332 -0.0301 -0.0239 -0.0167 -0.0092 -0.0003  0.0065  0.0197

## 
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.433% with total variance (sd as % of total bet): 596,487 ( 2.41% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0554 -0.0488 -0.0438 -0.0340 -0.0189 -0.0018  0.0166  0.0302  0.0509

## 
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.453% with total variance (sd as % of total bet): 2,277,007 ( 1.57% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0461 -0.0379 -0.0347 -0.0269 -0.0171 -0.0055  0.0053  0.0129  0.0265

## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.426% with total variance (sd as % of total bet): 4,381,243 ( 1.31% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0411 -0.0345 -0.0311 -0.0250 -0.0168 -0.0082  0.0009  0.0085  0.0203

## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.446% with total variance (sd as % of total bet): 11,950,050 ( 1.08% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0359 -0.0311 -0.0284 -0.0229 -0.0164 -0.0098 -0.0022  0.0044  0.0166

## 
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.438% with total variance (sd as % of total bet): 795,569 ( 2.23% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0544 -0.0466 -0.0417 -0.0326 -0.0181 -0.0027  0.0148  0.0260  0.0484

## 
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.49% with total variance (sd as % of total bet): 2,860,423 ( 1.41% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0433 -0.0363 -0.0325 -0.0250 -0.0158 -0.0068  0.0032  0.0106  0.0240

## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.416% with total variance (sd as % of total bet): 5,296,307 ( 1.15% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0395 -0.0330 -0.0299 -0.0242 -0.0165 -0.0089 -0.0010  0.0042  0.0154

## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.472% with total variance (sd as % of total bet): 15,665,331 ( 0.99% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0342 -0.0295 -0.0266 -0.0218 -0.0160 -0.0102 -0.0033  0.0024  0.0148

proc.time() - startTime
##    user  system elapsed 
##   77.38   23.87  101.37
# Run for BP 75
startTime <- proc.time()
bp75SimGameFull <- simGameFull(useList=bp75GameData, gameName="BP 75")
## 
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.11% with total variance (sd as % of total bet): 22,125 ( 14.87% )
##     1%     5%    10%    25%    50%    75%    90%    95%    99% 
## -0.181 -0.141 -0.124 -0.087 -0.041  0.008  0.065  0.110  0.773

## 
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.775% with total variance (sd as % of total bet): 74,536 ( 9.1% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1370 -0.1147 -0.1007 -0.0743 -0.0403 -0.0026  0.0498  0.2017  0.2917

## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.781% with total variance (sd as % of total bet): 124,857 ( 7.07% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1338 -0.1060 -0.0924 -0.0662 -0.0359  0.0018  0.0826  0.1222  0.1989

## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.011% with total variance (sd as % of total bet): 414,855 ( 6.44% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1141 -0.0939 -0.0813 -0.0592 -0.0314  0.0087  0.0486  0.0826  0.1443

## 
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.349% with total variance (sd as % of total bet): 43,611 ( 10.44% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1365 -0.1120 -0.0976 -0.0710 -0.0368  0.0005  0.0516  0.2530  0.4050

## 
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.789% with total variance (sd as % of total bet): 140,032 ( 6.24% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1133 -0.0927 -0.0817 -0.0605 -0.0357 -0.0042  0.0645  0.1033  0.1950

## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.071% with total variance (sd as % of total bet): 284,082 ( 5.33% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1041 -0.0828 -0.0725 -0.0539 -0.0310  0.0050  0.0504  0.0761  0.1501

## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.019% with total variance (sd as % of total bet): 808,576 ( 4.5% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0938 -0.0754 -0.0670 -0.0493 -0.0264  0.0028  0.0321  0.0502  0.0986

## 
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.052% with total variance (sd as % of total bet): 84,922 ( 7.29% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1140 -0.0925 -0.0815 -0.0610 -0.0371 -0.0069  0.0556  0.1605  0.2228

## 
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.91% with total variance (sd as % of total bet): 295,144 ( 4.53% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0907 -0.0755 -0.0667 -0.0515 -0.0310 -0.0008  0.0398  0.0640  0.1360

## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.879% with total variance (sd as % of total bet): 553,038 ( 3.72% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0835 -0.0687 -0.0610 -0.0461 -0.0272 -0.0011  0.0238  0.0401  0.0875

## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.094% with total variance (sd as % of total bet): 1,696,421 ( 3.26% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0767 -0.0606 -0.0531 -0.0401 -0.0232 -0.0022  0.0172  0.0321  0.0612

## 
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.145% with total variance (sd as % of total bet): 166,421 ( 5.1% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0900 -0.0753 -0.0675 -0.0522 -0.0326 -0.0023  0.0621  0.0804  0.1465

## 
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.921% with total variance (sd as % of total bet): 580,598 ( 3.17% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0733 -0.0627 -0.0565 -0.0429 -0.0259 -0.0036  0.0199  0.0382  0.0762

## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.94% with total variance (sd as % of total bet): 1,091,965 ( 2.61% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0677 -0.0586 -0.0509 -0.0384 -0.0238 -0.0063  0.0121  0.0253  0.0595

## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 97.963% with total variance (sd as % of total bet): 3,061,439 ( 2.19% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0618 -0.0505 -0.0449 -0.0344 -0.0222 -0.0090  0.0036  0.0125  0.0601

## 
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.07% with total variance (sd as % of total bet): 335,930 ( 3.62% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0781 -0.0648 -0.0571 -0.0455 -0.0282  0.0031  0.0279  0.0504  0.0850

## 
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.983% with total variance (sd as % of total bet): 1,169,491 ( 2.25% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0624 -0.0532 -0.0469 -0.0358 -0.0228 -0.0068  0.0101  0.0213  0.0384

## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.079% with total variance (sd as % of total bet): 2,376,711 ( 1.93% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0569 -0.0475 -0.0416 -0.0321 -0.0209 -0.0090  0.0048  0.0152  0.0382

## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 97.982% with total variance (sd as % of total bet): 6,071,057 ( 1.54% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0506 -0.0428 -0.0381 -0.0304 -0.0216 -0.0120 -0.0018  0.0055  0.0315

## 
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 97.987% with total variance (sd as % of total bet): 477,539 ( 2.88% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0688 -0.0575 -0.0519 -0.0416 -0.0254 -0.0031  0.0192  0.0326  0.0650

## 
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.946% with total variance (sd as % of total bet): 1,793,129 ( 1.86% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0556 -0.0479 -0.0435 -0.0340 -0.0224 -0.0084  0.0031  0.0113  0.0309

## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.025% with total variance (sd as % of total bet): 3,554,360 ( 1.57% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0497 -0.0430 -0.0383 -0.0308 -0.0215 -0.0099  0.0010  0.0079  0.0224

## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.067% with total variance (sd as % of total bet): 10,028,744 ( 1.32% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0453 -0.0386 -0.0346 -0.0283 -0.0204 -0.0117 -0.0028  0.0032  0.0213

## 
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.101% with total variance (sd as % of total bet): 657,849 ( 2.53% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0631 -0.0538 -0.0488 -0.0380 -0.0219 -0.0029  0.0157  0.0259  0.0495

## 
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 97.976% with total variance (sd as % of total bet): 2,341,528 ( 1.59% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0525 -0.0448 -0.0399 -0.0317 -0.0211 -0.0100  0.0002  0.0071  0.0207

## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.037% with total variance (sd as % of total bet): 4,570,808 ( 1.34% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0451 -0.0395 -0.0358 -0.0286 -0.0210 -0.0120 -0.0026  0.0039  0.0189

## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.013% with total variance (sd as % of total bet): 12,177,831 ( 1.09% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0414 -0.0361 -0.0329 -0.0274 -0.0206 -0.0136 -0.0062 -0.0011  0.0119

## 
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.007% with total variance (sd as % of total bet): 855,820 ( 2.31% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0606 -0.0520 -0.0474 -0.0370 -0.0224 -0.0063  0.0107  0.0226  0.0443

## 
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 98.039% with total variance (sd as % of total bet): 3,009,484 ( 1.45% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0484 -0.0414 -0.0369 -0.0299 -0.0209 -0.0110 -0.0007  0.0056  0.0202

## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.026% with total variance (sd as % of total bet): 5,852,070 ( 1.21% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0438 -0.0383 -0.0350 -0.0280 -0.0202 -0.0124 -0.0044  0.0016  0.0128

## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 97.994% with total variance (sd as % of total bet): 14,897,629 ( 0.96% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0396 -0.0348 -0.0316 -0.0266 -0.0210 -0.0142 -0.0076 -0.0036  0.0071

proc.time() - startTime
##    user  system elapsed 
##   77.59   24.96  102.93
# Run for DDB 96
startTime <- proc.time()
ddb96SimGameFull <- simGameFull(useList=ddb96GameData, gameName="DDB 96")
## 
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.588% with total variance (sd as % of total bet): 42,694 ( 20.66% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.2710 -0.2260 -0.2000 -0.1440 -0.0640  0.0520  0.2161  0.3880  0.7852

## 
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 99.289% with total variance (sd as % of total bet): 146,954 ( 12.78% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.2097 -0.1697 -0.1448 -0.0973 -0.0290  0.0567  0.1545  0.2234  0.4067

## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.906% with total variance (sd as % of total bet): 307,036 ( 11.08% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1818 -0.1524 -0.1316 -0.0882 -0.0281  0.0447  0.1212  0.1962  0.3368

## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.963% with total variance (sd as % of total bet): 937,444 ( 9.68% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1619 -0.1287 -0.1096 -0.0713 -0.0261  0.0357  0.0995  0.1409  0.3061

## 
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 99.02% with total variance (sd as % of total bet): 84,054 ( 14.5% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.2225 -0.1850 -0.1595 -0.1095 -0.0395  0.0561  0.1751  0.2890  0.4640

## 
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 99.129% with total variance (sd as % of total bet): 310,069 ( 9.28% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1723 -0.1329 -0.1135 -0.0747 -0.0235  0.0423  0.1212  0.1669  0.2573

## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 99.122% with total variance (sd as % of total bet): 602,022 ( 7.76% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1441 -0.1162 -0.0993 -0.0654 -0.0180  0.0358  0.0945  0.1291  0.2091

## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.867% with total variance (sd as % of total bet): 1,586,061 ( 6.3% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1270 -0.0978 -0.0818 -0.0536 -0.0189  0.0245  0.0696  0.0970  0.1878

## 
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.814% with total variance (sd as % of total bet): 166,471 ( 10.2% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1835 -0.1433 -0.1240 -0.0836 -0.0295  0.0408  0.1273  0.1775  0.3036

## 
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.785% with total variance (sd as % of total bet): 647,354 ( 6.7% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1359 -0.1054 -0.0896 -0.0597 -0.0204  0.0266  0.0789  0.1086  0.1748

## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.941% with total variance (sd as % of total bet): 1,275,093 ( 5.65% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1126 -0.0918 -0.0768 -0.0508 -0.0169  0.0235  0.0634  0.0872  0.1547

## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.976% with total variance (sd as % of total bet): 3,297,321 ( 4.54% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0925 -0.0745 -0.0614 -0.0417 -0.0148  0.0137  0.0450  0.0704  0.1199

## 
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 99.081% with total variance (sd as % of total bet): 340,123 ( 7.29% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1336 -0.1120 -0.0959 -0.0626 -0.0173  0.0354  0.0898  0.1200  0.1948

## 
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.85% with total variance (sd as % of total bet): 1,242,232 ( 4.64% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1000 -0.0778 -0.0670 -0.0439 -0.0162  0.0172  0.0474  0.0713  0.1217

## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 99.023% with total variance (sd as % of total bet): 2,524,338 ( 3.97% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0932 -0.0694 -0.0586 -0.0380 -0.0122  0.0151  0.0422  0.0568  0.0980

## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.987% with total variance (sd as % of total bet): 7,258,414 ( 3.37% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0764 -0.0589 -0.0498 -0.0323 -0.0129  0.0081  0.0307  0.0507  0.0921

## 
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 99.021% with total variance (sd as % of total bet): 657,509 ( 5.07% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1028 -0.0837 -0.0714 -0.0452 -0.0152  0.0206  0.0585  0.0828  0.1257

## 
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.923% with total variance (sd as % of total bet): 2,485,878 ( 3.28% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0771 -0.0607 -0.0514 -0.0337 -0.0134  0.0084  0.0329  0.0448  0.0783

## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.882% with total variance (sd as % of total bet): 4,912,885 ( 2.77% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0713 -0.0543 -0.0465 -0.0301 -0.0123  0.0063  0.0252  0.0355  0.0563

## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.941% with total variance (sd as % of total bet): 14,498,714 ( 2.38% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0575 -0.0459 -0.0404 -0.0268 -0.0121  0.0036  0.0187  0.0298  0.0581

## 
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.938% with total variance (sd as % of total bet): 1,051,209 ( 4.27% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0965 -0.0753 -0.0630 -0.0407 -0.0138  0.0161  0.0433  0.0633  0.1045

## 
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.976% with total variance (sd as % of total bet): 3,389,110 ( 2.56% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0656 -0.0506 -0.0420 -0.0279 -0.0116  0.0060  0.0219  0.0341  0.0577

## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.99% with total variance (sd as % of total bet): 7,702,623 ( 2.31% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0564 -0.0463 -0.0396 -0.0264 -0.0109  0.0049  0.0195  0.0291  0.0485

## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.98% with total variance (sd as % of total bet): 20,762,232 ( 1.9% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0501 -0.0390 -0.0325 -0.0228 -0.0117  0.0014  0.0144  0.0239  0.0419

## 
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 99% with total variance (sd as % of total bet): 1,344,528 ( 3.62% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0814 -0.0642 -0.0535 -0.0361 -0.0134  0.0131  0.0377  0.0550  0.0841

## 
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 98.864% with total variance (sd as % of total bet): 4,949,282 ( 2.32% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0584 -0.0471 -0.0403 -0.0270 -0.0128  0.0028  0.0198  0.0294  0.0471

## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.922% with total variance (sd as % of total bet): 9,072,346 ( 1.88% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0549 -0.0396 -0.0336 -0.0234 -0.0117  0.0012  0.0137  0.0206  0.0354

## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.962% with total variance (sd as % of total bet): 25,857,997 ( 1.59% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0452 -0.0356 -0.0301 -0.0209 -0.0110 -0.0003  0.0097  0.0173  0.0307

## 
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.98% with total variance (sd as % of total bet): 1,610,529 ( 3.17% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0743 -0.0580 -0.0484 -0.0320 -0.0126  0.0092  0.0315  0.0449  0.0735

## 
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 99.052% with total variance (sd as % of total bet): 6,292,565 ( 2.09% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0553 -0.0411 -0.0349 -0.0241 -0.0111  0.0048  0.0181  0.0270  0.0406

## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.949% with total variance (sd as % of total bet): 12,024,002 ( 1.73% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0461 -0.0373 -0.0321 -0.0225 -0.0115  0.0008  0.0118  0.0191  0.0336

## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.984% with total variance (sd as % of total bet): 36,147,438 ( 1.5% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0417 -0.0329 -0.0284 -0.0204 -0.0112 -0.0011  0.0095  0.0164  0.0299

proc.time() - startTime
##    user  system elapsed 
##   79.23   24.38  103.99

Next, find the minimum achieved in 8,000 5-play deals (4,000 simulations each) for JB 95, BP 75, and DDB 96 (this has now been converted to a function - see further below):

Assess the differences in minimum and final outcomes, as well as “risk of ruin”, for JB 95 at 8k hands (this has now been converted to a function - see further below):

Next, find the minima for 8,000 10-play deals (4,000 simulations each) for JB 95, BP 75, and DDB 96 (this has been converted to a function - see further below):

Assess the differences in minimum and final outcomes, as well as “risk of ruin”, for JB 95 at 8k deals (this has been converted to a function - see further below):

A function is written to assess the minima and final base-units achieved in X hands of game Y:

plotMinFinal <- function(gm1Min, gm1Sum, gm1Name, gm2Min, gm2Sum, gm2Name) {

    par(mfcol=c(1, 2))    

    # Plot the minima and final for gm1, ordered by lowest minimum
    plot(x=(1:length(gm1Min))/length(gm1Min), 
         y=gm1Sum[order(gm1Min)], 
         xlab="Percentile", ylab="Base Per-Hand Units", main=paste("Units for", gm1Name), 
         col="green", pch=19, cex=0.25, 
         ylim=round(range(c(gm1Sum, gm1Min)), -3) + c(-500, 500)
         )
    points(x=(1:length(gm1Min))/length(gm1Min), 
           y=gm1Min[order(gm1Min)], 
           col="orange", pch=19, cex=0.5
           )
    abline(h=0, v=c(0.01, 0.05, 0.1, 0.25, 0.5), lty=2)
    keyQuant <- quantile(gm1Min, c(0.01, 0.05, 0.1, 0.25, 0.5))
    legend("topleft", col=c("green", "orange"), pch=19, cex=0.65,
           legend=c("Final", paste0("Min ( ", paste(round(keyQuant,0), collapse=" "), " )")) 
           )

    # Plot the minima and final for gm2, ordered by lowest minimum
    plot(x=(1:length(gm2Min))/length(gm2Min), 
         y=gm2Sum[order(gm2Min)], 
         xlab="Percentile", ylab="Base Per-Hand Units", main=paste("Units for", gm2Name), 
         col="green", pch=19, cex=0.25, 
         ylim=round(range(c(gm2Sum, gm2Min)), -3) + c(-500, 500)
         )
    points(x=(1:length(gm2Min))/length(gm2Min), 
           y=gm2Min[order(gm2Min)], 
           col="orange", pch=19, cex=0.5
           )
    abline(h=0, v=c(0.01, 0.05, 0.1, 0.25, 0.5), lty=2)
    keyQuant <- quantile(gm2Min, c(0.01, 0.05, 0.1, 0.25, 0.5))
    legend("topleft", col=c("green", "orange"), pch=19, cex=0.65,
           legend=c("Final", paste0("Min ( ", paste(round(keyQuant,0), collapse=" "), " )")) 
           )
    
    par(mfcol=c(1, 1))
    
}

The function is then applied for multiple scenarios, with the input data first run and cached:

jb95_05p_08k <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, useName="JB 95", 
                          nPlay=5, nHands=8000, nSims=4000, genCumMin=TRUE
                          )
## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.464% with total variance (sd as % of total bet): 1,086,549 ( 2.61% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0607 -0.0510 -0.0444 -0.0333 -0.0188 -0.0016  0.0174  0.0319  0.0722

bp75_05p_08k <- sim_NPlay(keyFrame=bp75GameData$game_05Play$dfOutcome, useName="BP 75", 
                          nPlay=5, nHands=8000, nSims=4000, genCumMin=TRUE
                          )
## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 98.045% with total variance (sd as % of total bet): 1,127,555 ( 2.65% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0667 -0.0564 -0.0494 -0.0379 -0.0226 -0.0053  0.0134  0.0284  0.0651

ddb96_05p_08k <- sim_NPlay(keyFrame=ddb96GameData$game_05Play$dfOutcome, useName="DDB 96", 
                           nPlay=5, nHands=8000, nSims=4000, genCumMin=TRUE
                           )
## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 98.949% with total variance (sd as % of total bet): 2,389,963 ( 3.86% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0886 -0.0687 -0.0571 -0.0376 -0.0136  0.0129  0.0389  0.0555  0.1001

jb95_05p_04k <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, useName="JB 95", 
                          nPlay=5, nHands=4000, nSims=4000, genCumMin=TRUE
                          )
## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.449% with total variance (sd as % of total bet): 537,349 ( 3.67% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0742 -0.0611 -0.0537 -0.0399 -0.0226  0.0029  0.0290  0.0461  0.1046

jb95_05p_02k <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, useName="JB 95", 
                          nPlay=5, nHands=2000, nSims=4000, genCumMin=TRUE
                          )
## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.574% with total variance (sd as % of total bet): 277,822 ( 5.27% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0909 -0.0750 -0.0652 -0.0471 -0.0263  0.0075  0.0519  0.0768  0.1475

jb95_10p_08k <- sim_NPlay(keyFrame=jb95GameData$game_10Play$out10Play, useName="JB 95", 
                          nPlay=10, nHands=8000, nSims=4000, genCumMin=TRUE
                          )
## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.442% with total variance (sd as % of total bet): 2,877,689 ( 2.12% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0538 -0.0445 -0.0386 -0.0293 -0.0178 -0.0050  0.0084  0.0181  0.0658

bp75_10p_08k <- sim_NPlay(keyFrame=bp75GameData$game_10Play$out10Play, useName="BP 75", 
                          nPlay=10, nHands=8000, nSims=4000, genCumMin=TRUE
                          )
## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.015% with total variance (sd as % of total bet): 3,276,298 ( 2.26% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0599 -0.0500 -0.0450 -0.0343 -0.0222 -0.0087  0.0057  0.0162  0.0647

ddb96_10p_08k <- sim_NPlay(keyFrame=ddb96GameData$game_10Play$out10Play, useName="DDB 96", 
                           nPlay=10, nHands=8000, nSims=4000, genCumMin=TRUE
                           )
## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 98.796% with total variance (sd as % of total bet): 6,517,469 ( 3.19% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0763 -0.0586 -0.0496 -0.0339 -0.0148  0.0066  0.0283  0.0420  0.0797

jb95_10p_04k <- sim_NPlay(keyFrame=jb95GameData$game_10Play$out10Play, useName="JB 95", 
                          nPlay=10, nHands=4000, nSims=4000, genCumMin=TRUE
                          )
## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.381% with total variance (sd as % of total bet): 1,336,088 ( 2.89% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0687 -0.0554 -0.0478 -0.0353 -0.0196 -0.0002  0.0185  0.0301  0.0626

jb95_10p_02k <- sim_NPlay(keyFrame=jb95GameData$game_10Play$out10Play, useName="JB 95", 
                          nPlay=10, nHands=2000, nSims=4000, genCumMin=TRUE
                          )
## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.543% with total variance (sd as % of total bet): 875,297 ( 4.68% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0830 -0.0683 -0.0597 -0.0427 -0.0207  0.0055  0.0333  0.0541  0.0976

The function is run for:

  • JB 95 5/10-play (each at 8k deals) vs. DDB 96 5/10-play (each at 8k deals)
  • JB 95 5/10-play (each at 8k deals) vs. BP 75 5/10-play (each at 8k deals)
  • JB 95 5-play (8k deals) vs. JB 95 5-play (once each as 4k/2k deals)
  • JB 95 10-play (8k deals) vs. JB 95 10-play (once each as 4k/2k deals)
# JB 95 5-play (8k deals) vs. DDB 96 5-play (8k deals)
plotMinFinal(gm1Min=jb95_05p_08k$cumminNPlay, gm1Sum=jb95_05p_08k$sumsNPlay, 
             gm1Name="JB 95 5-play (8k deals)", 
             gm2Min=ddb96_05p_08k$cumminNPlay, gm2Sum=ddb96_05p_08k$sumsNPlay, 
             gm2Name="DDB 96 5-play (8k deals)"
             )

# JB 95 5-play (8k deals) vs. BP 75 5-play (8k deals)
plotMinFinal(gm1Min=jb95_05p_08k$cumminNPlay, gm1Sum=jb95_05p_08k$sumsNPlay, 
             gm1Name="JB 95 5-play (8k deals)", 
             gm2Min=bp75_05p_08k$cumminNPlay, gm2Sum=bp75_05p_08k$sumsNPlay, 
             gm2Name="BP 75 5-play (8k deals)"
             )

# JB 95 5-play (8k deals) vs. JB 95 5-play (4k deals)
plotMinFinal(gm1Min=jb95_05p_08k$cumminNPlay, gm1Sum=jb95_05p_08k$sumsNPlay, 
             gm1Name="JB 95 5-play (8k deals)", 
             gm2Min=jb95_05p_04k$cumminNPlay, gm2Sum=jb95_05p_04k$sumsNPlay, 
             gm2Name="JB 95 5-play (4k deals)"
             )

# JB 95 5-play (8k deals) vs. JB 95 5-play (2k deals)
plotMinFinal(gm1Min=jb95_05p_08k$cumminNPlay, gm1Sum=jb95_05p_08k$sumsNPlay, 
             gm1Name="JB 95 5-play (8k deals)", 
             gm2Min=jb95_05p_02k$cumminNPlay, gm2Sum=jb95_05p_02k$sumsNPlay, 
             gm2Name="JB 95 5-play (2k deals)"
             )

# JB 95 10-play (8k deals) vs. DDB 96 10-play (8k deals)
plotMinFinal(gm1Min=jb95_10p_08k$cumminNPlay, gm1Sum=jb95_10p_08k$sumsNPlay, 
             gm1Name="JB 95 10-play (8k deals)", 
             gm2Min=ddb96_10p_08k$cumminNPlay, gm2Sum=ddb96_10p_08k$sumsNPlay, 
             gm2Name="DDB 96 10-play (8k deals)"
             )

# JB 95 10-play (8k deals) vs. JB 95 10-play (4k deals)
plotMinFinal(gm1Min=jb95_10p_08k$cumminNPlay, gm1Sum=jb95_10p_08k$sumsNPlay, 
             gm1Name="JB 95 10-play (8k deals)", 
             gm2Min=jb95_10p_04k$cumminNPlay, gm2Sum=jb95_10p_04k$sumsNPlay, 
             gm2Name="JB 95 10-play (4k deals)"
             )

# JB 95 10-play (8k deals) vs. JB 95 10-play (2k deals)
plotMinFinal(gm1Min=jb95_10p_08k$cumminNPlay, gm1Sum=jb95_10p_08k$sumsNPlay, 
             gm1Name="JB 95 10-play (8k deals)", 
             gm2Min=jb95_10p_02k$cumminNPlay, gm2Sum=jb95_10p_02k$sumsNPlay, 
             gm2Name="JB 95 10-play (2k deals)"
             )

A function is written to assess the “risk of ruin” as well as the differences in the final result and the minimum result for a particular game:

rrMinFinal <- function(gMin, gSum, gName, g2Min, g2Sum, g2Name) {
    
    par(mfcol=c(1, 2))

    
    # Game 1 Plots (Min vs. Final)
    plot(x=gMin, y=gSum-gMin, 
         main=paste0("Final vs. Min (", gName, ")"), 
         xlab="Minimum", ylab="Final - Minimum", 
         pch=19, col=rgb(0, 0, 0.5, 0.25)
         )
    tmpSmooth <- loess.smooth(y=(gSum-gMin), x=gMin)
    lines(tmpSmooth$x, tmpSmooth$y, col="red", lwd=2)

    hist(pmin(1000, gSum-gMin), 
         col="light blue", 
         main=paste0("Final vs. Min (", gName, ")"), 
         xlab="Final - Min (capped at 1,000)"
     )

    # Game 2 Plots (Min vs. Final)
    plot(x=g2Min, y=g2Sum-g2Min, 
         main=paste0("Final vs. Min (", g2Name, ")"), 
         xlab="Minimum", ylab="Final - Minimum", 
         pch=19, col=rgb(0, 0, 0.5, 0.25)
         )
    tmpSmooth <- loess.smooth(y=(g2Sum-g2Min), x=g2Min)
    lines(tmpSmooth$x, tmpSmooth$y, col="red", lwd=2)

    hist(pmin(1000, g2Sum-g2Min), 
         col="light blue", 
         main=paste0("Final vs. Min (", g2Name, ")"), 
         xlab="Final - Min (capped at 1,000)"
     )

    # Risk of Ruin Plots
    xWorst <- floor(min(gMin)/50) * 50
    xVals <- seq(xWorst, 0, by=50)
    yVals <- sapply(xVals, FUN=function(x) { sum(gMin < x) })
    plot(x=xVals, y=yVals/length(gMin), 
         pch=19, col="blue", 
         main=paste0("RR (", gName, ")"), 
         xlab="Units", ylab="Risk of Ruin"
         )
    rrX <- c(0.01, 0.05, 0.1, 0.25)
    rrY <- quantile(gMin, rrX)
    abline(h=rrX, v=rrY, lty=2, lwd=1, 
           col=c("red", "orange", "purple", "dark green")
           )
    legend("topleft", lty=2, cex=0.85, 
           legend=paste0(100*rrX, "%", " (", prettyNum(round(rrY, 0), big.mark=","),")"), 
           col=c("red", "orange", "purple", "dark green")
           )

    xWorst <- floor(min(g2Min)/50) * 50
    xVals <- seq(xWorst, 0, by=50)
    yVals <- sapply(xVals, FUN=function(x) { sum(g2Min < x) })
    plot(x=xVals, y=yVals/length(g2Min), 
         pch=19, col="blue", 
         main=paste0("RR (", g2Name, ")"), 
         xlab="Units", ylab="Risk of Ruin"
         )
    rrX <- c(0.01, 0.05, 0.1, 0.25)
    rrY <- quantile(g2Min, rrX)
    abline(h=rrX, v=rrY, lty=2, lwd=1, 
           col=c("red", "orange", "purple", "dark green")
           )
    legend("topleft", lty=2, cex=0.85, 
           legend=paste0(100*rrX, "%", " (", prettyNum(round(rrY, 0), big.mark=","),")"), 
           col=c("red", "orange", "purple", "dark green")
           )

        
    par(mfcol=c(1, 1))
    
}

The function is then applied for the following:

  • JB 95 5-play (8k deals) and JB 95 5-play (2k deals)
  • JB 95 10-play (8k deals) and JB 95 10-play (2k deals)
rrMinFinal(gMin=jb95_05p_08k$cumminNPlay, gSum=jb95_05p_08k$sumsNPlay, 
           gName="8k deals of 5-play JB 95", 
           g2Min=jb95_05p_02k$cumminNPlay, g2Sum=jb95_05p_02k$sumsNPlay, 
           g2Name="2k deals of 5-play JB 95"
           )

rrMinFinal(gMin=jb95_10p_08k$cumminNPlay, gSum=jb95_10p_08k$sumsNPlay, 
           gName="8k deals of 10-play JB 95", 
           g2Min=jb95_10p_02k$cumminNPlay, g2Sum=jb95_10p_02k$sumsNPlay, 
           g2Name="2k deals of 10-play JB 95"
           )

Next, the sim_NPlay function is adapted to explore the minimum results by number of hands, for example by simulating 24,000 deals and assessing the percentiles for total results at each of 1-24,000 hands. To keep file sizes reasonable, results are stored only once every 100 hands by default. The routine is run for the 10/5/3/1-play games for JB 95, BP 75, and DDB 96 at 24,000 hands. Results are cached:

jb95_05p_24k_fullmin <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, 
                                  useName="JB 95", nPlay=5, nHands=24000, nSims=4000, 
                                  genCumMin=TRUE, genFullMin=TRUE
                                  )
## 
## Mean return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.483% with total variance (sd as % of total bet): 3,242,892 ( 1.5% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0441 -0.0372 -0.0331 -0.0257 -0.0163 -0.0068  0.0038  0.0117  0.0291

bp75_05p_24k_fullmin <- sim_NPlay(keyFrame=bp75GameData$game_05Play$dfOutcome, 
                                  useName="BP 75", nPlay=5, nHands=24000, nSims=4000, 
                                  genCumMin=TRUE, genFullMin=TRUE
                                  )
## 
## Mean return per hand: 0.9801439 with total variance: 145.3524
## Mean return per hand: 97.983% with total variance (sd as % of total bet): 3,584,825 ( 1.58% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0514 -0.0436 -0.0390 -0.0311 -0.0212 -0.0111  0.0001  0.0078  0.0242

ddb96_05p_24k_fullmin <- sim_NPlay(keyFrame=ddb96GameData$game_05Play$dfOutcome, 
                                   useName="DDB 96", nPlay=5, nHands=24000, nSims=4000, 
                                   genCumMin=TRUE, genFullMin=TRUE
                                   )
## 
## Mean return per hand: 0.9898018 with total variance: 306.0667
## Mean return per hand: 99.003% with total variance (sd as % of total bet): 7,124,294 ( 2.22% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0585 -0.0436 -0.0369 -0.0254 -0.0109  0.0038  0.0189  0.0292  0.0473

jb95_10p_24k_fullmin <- sim_NPlay(keyFrame=jb95GameData$game_10Play$out10Play, 
                                  useName="JB 95", nPlay=10, nHands=24000, nSims=4000, 
                                  genCumMin=TRUE, genFullMin=TRUE
                                  )
## 
## Mean return per hand: 0.9844824 with total variance: 369.7508
## Mean return per hand: 98.416% with total variance (sd as % of total bet): 8,775,328 ( 1.23% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0401 -0.0334 -0.0301 -0.0241 -0.0170 -0.0092 -0.0010  0.0061  0.0241

jb95_03p_24k_fullmin <- sim_NPlay(keyFrame=jb95GameData$game_03Play$dfOutcome, 
                                  useName="JB 95", nPlay=3, nHands=24000, nSims=4000, 
                                  genCumMin=TRUE, genFullMin=TRUE
                                  )
## 
## Mean return per hand: 0.9844976 with total variance: 70.16407
## Mean return per hand: 98.468% with total variance (sd as % of total bet): 1,698,700 ( 1.81% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0494 -0.0413 -0.0369 -0.0281 -0.0172 -0.0047  0.0080  0.0170  0.0359

jb95_01p_24k_fullmin <- sim_NPlay(keyFrame=jb95GameData$game_01Play$dfOutcome, 
                                  useName="JB 95", nPlay=1, nHands=24000, nSims=4000, 
                                  genCumMin=TRUE, genFullMin=TRUE
                                  )
## 
## Mean return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.41% with total variance (sd as % of total bet): 448,292 ( 2.79% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0589 -0.0515 -0.0465 -0.0370 -0.0214  0.0008  0.0220  0.0356  0.0691

bp75_10p_24k_fullmin <- sim_NPlay(keyFrame=bp75GameData$game_10Play$out10Play, 
                                  useName="BP 75", nPlay=10, nHands=24000, nSims=4000, 
                                  genCumMin=TRUE, genFullMin=TRUE
                                  )
## 
## Mean return per hand: 0.9801308 with total variance: 394.3983
## Mean return per hand: 98.039% with total variance (sd as % of total bet): 9,939,176 ( 1.31% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0442 -0.0385 -0.0351 -0.0283 -0.0211 -0.0125 -0.0036  0.0034  0.0220

bp75_03p_24k_fullmin <- sim_NPlay(keyFrame=bp75GameData$game_03Play$dfOutcome, 
                                  useName="BP 75", nPlay=3, nHands=24000, nSims=4000, 
                                  genCumMin=TRUE, genFullMin=TRUE
                                  )
## 
## Mean return per hand: 0.980147 with total variance: 74.74454
## Mean return per hand: 98.03% with total variance (sd as % of total bet): 1,775,375 ( 1.85% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0556 -0.0472 -0.0420 -0.0330 -0.0212 -0.0085  0.0048  0.0131  0.0305

bp75_01p_24k_fullmin <- sim_NPlay(keyFrame=bp75GameData$game_01Play$dfOutcome, 
                                  useName="BP 75", nPlay=1, nHands=24000, nSims=4000, 
                                  genCumMin=TRUE, genFullMin=TRUE
                                  )
## 
## Mean return per hand: 0.9801482 with total variance: 20.75481
## Mean return per hand: 98.058% with total variance (sd as % of total bet): 487,171 ( 2.91% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0688 -0.0581 -0.0520 -0.0407 -0.0244 -0.0023  0.0206  0.0340  0.0651

ddb96_10p_24k_fullmin <- sim_NPlay(keyFrame=ddb96GameData$game_10Play$out10Play, 
                                   useName="DDB 96", nPlay=10, nHands=24000, nSims=4000, 
                                   genCumMin=TRUE, genFullMin=TRUE
                                   )
## 
## Mean return per hand: 0.9897956 with total variance: 852.4156
## Mean return per hand: 99.039% with total variance (sd as % of total bet): 21,617,924 ( 1.94% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0484 -0.0388 -0.0330 -0.0233 -0.0110  0.0025  0.0157  0.0244  0.0405

ddb96_03p_24k_fullmin <- sim_NPlay(keyFrame=ddb96GameData$game_03Play$dfOutcome, 
                                   useName="DDB 96", nPlay=3, nHands=24000, nSims=4000, 
                                   genCumMin=TRUE, genFullMin=TRUE
                                   )
## 
## Mean return per hand: 0.989809 with total variance: 154.8178
## Mean return per hand: 99.059% with total variance (sd as % of total bet): 3,812,166 ( 2.71% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0654 -0.0518 -0.0435 -0.0277 -0.0110  0.0074  0.0261  0.0372  0.0591

ddb96_01p_24k_fullmin <- sim_NPlay(keyFrame=ddb96GameData$game_01Play$dfOutcome, 
                                   useName="DDB 96", nPlay=1, nHands=24000, nSims=4000, 
                                   genCumMin=TRUE, genFullMin=TRUE
                                   )
## 
## Mean return per hand: 0.9898074 with total variance: 41.98469
## Mean return per hand: 98.887% with total variance (sd as % of total bet): 1,006,346 ( 4.18% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0965 -0.0747 -0.0618 -0.0405 -0.0139  0.0148  0.0442  0.0618  0.1005

Next, the “risk of ruin” is assessed for varying starting amounts, with the results graphed. A function is written for easy re-application:

graphRRSurvival <- function(keyData, keyName, keyPct=c(1, 0.95, 0.8, 0.5), 
                            keyCol=c("red", "orange", "purple", "blue", "grey", "green"), 
                            keyBanks=seq(1000, 6000, by=1000)
                            ) {

    # Survival Curves for keyData
    handNum <- 1
    mtxData <- matrix(data=NA, nrow=length(keyCol), ncol=length(keyPct))
    for (nBank in keyBanks) {
        mtxSurv <- rowMeans(keyData > -nBank)
        if (handNum == 1) {
            plot(x=as.numeric(names(mtxSurv)), y=unname(mtxSurv), 
                 main=paste0("Survival Curves (", keyName, ")"), 
                 xlab="# Hands", ylab="Survival", 
                 pch=19, col=keyCol[handNum], cex=0.5, 
                 ylim=c(0, 1), xlim=c(0, max(as.integer(rownames(keyData))))
                 )
        } else {
            points(x=as.numeric(names(mtxSurv)), y=unname(mtxSurv), 
                   pch=19, col=keyCol[handNum], cex=0.5
            )
        }
        for (intCtr in seq_along(keyPct)) {
            mtxData[handNum, intCtr] <- 
                as.numeric(names(mtxSurv)[sum(mtxSurv >= keyPct[intCtr])])
        }
        handNum <- handNum + 1
    }

    abline(h=keyPct, lty=2)
    topRow <- paste("Units     ( ", 
                    paste(paste0(round(100*keyPct, 1), "%"), collapse="  |      "), 
                    " )"
                    )
    appData <- apply(mtxData, 1, 
                     FUN=function(x) { 
                         paste(format(round(x/1000, 1), nsmall=1, width=5), collapse="k   |   ")
                         } 
                     )
    legend("bottomleft", 
           legend=c(topRow, 
                    paste0(sprintf("%.2f", round(keyBanks/1000, 2)), 
                           "k      ( ", appData, "k )"
                           )
                    ), 
           col=c("white", keyCol), cex=0.8, pch=19, pt.cex=1.2
           )

}

The JB 95 game is then assessed out to 24,000 deals for 10/5/3/1-play, assuming starting amounts equivalent to 1,000-6,000 units (increments of 1,000) in the 5-play game. A “unit” is the amount required to play a single line of the N-play game, so the total bet ber deal would be N * “unit”:

graphRRSurvival(keyData=jb95_10p_24k_fullmin$fullminNPlay, 
                keyName="JB 95 10-play", keyBanks=seq(2000, 12000, by=2000)
                )

graphRRSurvival(keyData=jb95_05p_24k_fullmin$fullminNPlay, 
                keyName="JB 95 5-play", keyBanks=seq(1000, 6000, by=1000)
                )

graphRRSurvival(keyData=jb95_03p_24k_fullmin$fullminNPlay, 
                keyName="JB 95 3-play", keyBanks=seq(600, 3600, by=600)
                )

graphRRSurvival(keyData=jb95_01p_24k_fullmin$fullminNPlay, 
                keyName="JB 95 1-play", keyBanks=seq(200, 1200, by=200)
                )

The BP 75 game is then assessed out to 24,000 deals for 10/5/3/1-play, assuming starting amounts equivalent to 1,000-6,000 units (increments of 1,000) in the 5-play game. A “unit” is the amount required to play a single line of the N-play game, so the total bet ber deal would be N * “unit”:

graphRRSurvival(keyData=bp75_10p_24k_fullmin$fullminNPlay, 
                keyName="BP 75 10-play", keyBanks=seq(2000, 12000, by=2000)
                )

graphRRSurvival(keyData=bp75_05p_24k_fullmin$fullminNPlay, 
                keyName="BP 75 5-play", keyBanks=seq(1000, 6000, by=1000)
                )

graphRRSurvival(keyData=bp75_03p_24k_fullmin$fullminNPlay, 
                keyName="BP 75 3-play", keyBanks=seq(600, 3600, by=600)
                )

graphRRSurvival(keyData=bp75_01p_24k_fullmin$fullminNPlay, 
                keyName="BP 75 1-play", keyBanks=seq(200, 1200, by=200)
                )

The DDB 96 game is then assessed out to 24,000 deals for 10/5/3/1-play, assuming starting amounts equivalent to 1,000-6,000 units (increments of 1,000) in the 5-play game. A “unit” is the amount required to play a single line of the N-play game, so the total bet ber deal would be N * “unit”:

graphRRSurvival(keyData=ddb96_10p_24k_fullmin$fullminNPlay, 
                keyName="DDB 96 10-play", keyBanks=seq(2000, 12000, by=2000)
                )

graphRRSurvival(keyData=ddb96_05p_24k_fullmin$fullminNPlay, 
                keyName="DDB 96 5-play", keyBanks=seq(1000, 6000, by=1000)
                )

graphRRSurvival(keyData=ddb96_03p_24k_fullmin$fullminNPlay, 
                keyName="DDB 96 3-play", keyBanks=seq(600, 3600, by=600)
                )

graphRRSurvival(keyData=ddb96_01p_24k_fullmin$fullminNPlay, 
                keyName="DDB 96 1-play", keyBanks=seq(200, 1200, by=200)
                )

The sim_NPlay function is adapted for the STP game, with a first pass at the results attempted:

jb95_05p_10k_fullmin_base <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, 
                                       useName="JB 95", nPlay=5, nHands=10000, nSims=4000, 
                                       genCumMin=TRUE, genFullMin=TRUE
                                       )
## 
## Mean base return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.449% with total variance (sd as % of total bet): 1,390,129 ( 2.36% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0580 -0.0478 -0.0419 -0.0316 -0.0182 -0.0029  0.0136  0.0252  0.0549

jb95_05p_10k_fullmin_stp <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, 
                                      useName="JB 95", nPlay=5, nHands=10000, nSims=4000, 
                                      genCumMin=TRUE, genFullMin=TRUE, runSTP=TRUE
                                      )
## 
## Mean base return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.635% with total variance (sd as % of total bet): 3,049,299 ( 2.91% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0622 -0.0519 -0.0444 -0.0321 -0.0172 -0.0006  0.0193  0.0381  0.0789

graphRRSurvival(keyData=jb95_05p_10k_fullmin_base$fullminNPlay, 
                keyName="JB 95 5-play", keyBanks=seq(1000, 6000, by=1000)
                )

graphRRSurvival(keyData=jb95_05p_10k_fullmin_stp$fullminNPlay, 
                keyName="JB 95 5-play (STP)", keyBanks=seq(1000, 6000, by=1000)
                )

Next, a sequence of very-low-pay games is created and assessed:

  • JB 8-5 (regular and STP)
  • JB 7-5 (regular and STP)
  • BP 6-5 (regular and STP)
  • DDB 9-5 (regular and STP)
  • DDB 8-5 (regular and STP)

The results are cached for run-time improvement:

# Define the paytable and simulate the holds (JB 85)
startTime <- proc.time()
jb85hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                 799, 49,  7,  4,  3, 
                                                   2,  1,  0,  0,  0, 
                                                   0, -1, -1, 24, 24, 
                                                  24, 24, 24, 24, 24, 
                                                  24, 24, 24, 24, 24
                                            )
                        )
jb85GameData <- genGame(hnd2Score=jb85hnd2Score, useGameName="JB 85")
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6665  -1.0000 799.0000 
## 
## # A tibble: 10 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  337920
## 3        1  123552
## 4        2   54912
## 5        3   10200
## 6        4    5108
## 7        7    3744
## 8       24     624
## 9       49      36
## 10     799       4
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.0000 -0.9375 -0.8750 -0.6665 -0.6250 24.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9107 -0.8138 -0.8138 -0.6665 -0.6624  3.2040 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8132 -0.7740 -0.6907 -0.6665 -0.6515  0.5045 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7211 -0.7083 -0.7083 -0.6665 -0.5702 -0.5616 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6458  -0.5219  -0.1865  -0.0270  -0.0426 799.0000 
## 
## [1] 0.9729843

## [1] "Game JB 85:  Return: 0.97298 and Variance on Deal: 1.903"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -74.5800 -29.2300 -15.6400 -12.8300  -0.6415 786.9000 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -76.88  -34.09  -24.09  -24.65  -13.77   11.44 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -115.300  -49.240  -29.500  -24.970   -8.499  841.000 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -121.6000  -55.0100  -39.4300  -40.5300  -23.5200    0.5264 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -184.90  -85.34  -56.59  -53.44  -28.31  783.60 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -190.1000  -93.8200  -69.5900  -70.5100  -44.8300    0.3851 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -309.80 -154.10 -114.00 -105.00  -68.54  812.50 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -317.800 -163.700 -125.700 -126.900  -88.560    3.241 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -517.9  -280.7  -223.2  -215.3  -162.9   739.7 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -525.300 -292.500 -238.900 -239.300 -183.700   -4.501 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -875.7  -527.9  -449.3  -435.2  -368.3   790.5 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -894.600 -541.300 -462.300 -462.300 -385.700   -6.652 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1270.0  -809.0  -702.0  -679.4  -597.0  1062.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1273.000  -822.100  -717.500  -712.400  -616.100    -5.039 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1770.0 -1257.0 -1104.0 -1077.0  -959.0   989.9 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1770.00 -1271.00 -1123.00 -1111.00  -982.70   -54.98

##    rndScore      ct      per
## 1        -1  899100      2.9
## 2         0 1158420      2.2
## 3         1  341496      7.6
## 4         2  124500     20.9
## 5         3   65148     39.9
## 6         4    4952    524.8
## 7         7    3744    694.2
## 8        17     752   3456.1
## 9        18      52  49980.0
## 10       19     132  19689.1
## 11       24     624   4165.0
## 12       49      36  72193.3
## 13      799       4 649740.0
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
## 
##  Summary of JB 85 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2210   18052    9495   81971   18886    3845 
## 
##      1 
## 134459 
## 
## [1] "JB 85: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6458  -0.5219  -0.1865  -0.0270  -0.0426 799.0000 
## [1] "Overall Return: 0.972984"
## 
## [1] "JB 85: Variances (Deal, Draw)"
## [1] "Deal Variance: 1.9031"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     2.437     3.392    17.420     4.402 13300.000

## 
## 
## This will assess the JB 85 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 
## 4 7 5 
## 5 4 6 
## 6 3 7 
## 7 2 8 
## 8 1 9 
## 9 0 10 11 12 13 
## 10 24 16 17 18 19 20 21 22 23 24 25 26 27 
## [1] 1270
##  num [1:1270, 1:10] 0 0 0 0 33 ...
##      rSum  ct
## 1       1   6
## 2      47  34
## 3    1081 105
## 4   16215  95
## 5  178365 155
## 6 1533939 875
##  chr [1:134459] "0-0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-0-1" ...
##  chr [1:1270] "0-0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0-0" ...
##  int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
##  num [1:1270(1d)] 624 3744 54912 123552 96 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1270] "1" "2" "3" "4" ...

## [1] 0.9729843
## [1] 17.4202
##    scoreType    occPer   contRet    occFreq
## 2        799 40170.000  0.019891 0.00002489
## 3         49  9288.000  0.005276 0.00010766
## 10        24   423.200  0.056709 0.00236289
## 4          7    86.850  0.080596 0.01151368
## 5          4    91.730  0.043606 0.01090156
## 6          3    89.010  0.033705 0.01123512
## 7          2    13.430  0.148925 0.07446275
## 8          1     7.734  0.129298 0.12929841
## 9          0     4.650  0.000000 0.21507064
## 1         -1     1.835 -0.545022 0.54502239
## 
## Printed table suggests JB 85 mean return: 0.972984 and overall variance: 19.32047 
## 
## List of 1
##  $ : int [1:10] 1 2 3 4 5 6 7 8 9 10
## 
##    1 
## 1270 
##  int [1:10, 1] 1 2 3 4 5 6 7 8 9 10
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 10 
## 
## Moving to assess the: 10 rows of outcomes
## 
## 
## Mean: 0.9729843      Variance: 19.32326 
## List of 3
##  $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1270 
##  int [1:1000, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 110 
## 
## Moving to assess the: 110 rows of outcomes
##  num [1:1270, 1:3, 1:3] 0 0 0 0 0 ...
##  num [1:1270, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## 
## 
## Mean: 0.9729843      Variance: 69.38814 
## List of 5
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1270 
##  int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 394 
## 
## Moving to assess the: 394 rows of outcomes
##  num [1:1270, 1:95] 0.0 0.0 0.0 0.0 9.5e-06 ...
##  num [1:1270] 0 0 0 0 0.000285 ...
## [1] 100
##  num [1:1270, 1:545] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1270, 1:130] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 ...
## [1] 300
## 
## 
## Mean: 0.9729843      Variance: 134.6775 
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1270 
##  int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 394 
## 
## Moving to assess the: 394 rows of outcomes
##  num [1:1270, 1:95] 0.0 0.0 0.0 0.0 9.5e-06 ...
##  num [1:1270] 0 0 0 0 0.000285 ...
## [1] 100
##  num [1:1270, 1:545] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1270, 1:130] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 ...
## [1] 300
## 
## 
## Mean: 0.9729843      Variance: 364.508 
## 
## Mean base return per hand: 0.9729679 with total variance: 364.1599
## Mean return per hand: 97.295% with total variance (sd as % of total bet): 5,569,441 ( 1.47% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0540 -0.0480 -0.0437 -0.0365 -0.0288 -0.0187 -0.0100 -0.0018  0.0220

## 
## Mean base return per hand: 0.9729817 with total variance: 134.6626
## Mean return per hand: 97.251% with total variance (sd as % of total bet): 2,099,216 ( 1.81% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0620 -0.0545 -0.0491 -0.0395 -0.0291 -0.0175 -0.0043  0.0046  0.0250

##  num [1:1270, 1:10] 0 0 0 0 0.702 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:10] "" "" "" "" ...
## [1] TRUE
## [1] TRUE
proc.time() - startTime
##    user  system elapsed 
##  117.41    9.72  127.80
# Define the paytable and simulate the holds (JB 75)
startTime <- proc.time()
jb75hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                 799, 49,  6,  4,  3, 
                                                   2,  1,  0,  0,  0, 
                                                   0, -1, -1, 24, 24, 
                                                  24, 24, 24, 24, 24, 
                                                  24, 24, 24, 24, 24
                                            )
                        )
jb75GameData <- genGame(hnd2Score=jb75hnd2Score, useGameName="JB 75")
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -1.000  -1.000  -1.000  -0.668  -1.000 799.000 
## 
## # A tibble: 10 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  337920
## 3        1  123552
## 4        2   54912
## 5        3   10200
## 6        4    5108
## 7        6    3744
## 8       24     624
## 9       49      36
## 10     799       4
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.0000 -0.9375 -0.8750 -0.6680 -0.6250 24.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9107 -0.8138 -0.8138 -0.6680 -0.6624  3.1430 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8141 -0.7749 -0.6916 -0.6680 -0.6524  0.4947 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7225 -0.7097 -0.7097 -0.6680 -0.5716 -0.5631 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6472  -0.5235  -0.1967  -0.0385  -0.0426 799.0000 
## 
## [1] 0.9614721

## [1] "Game JB 75:  Return: 0.96147 and Variance on Deal: 1.864"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -78.360 -34.690 -21.510 -18.590  -6.808 781.800 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -80.480 -38.770 -28.420 -28.600 -17.420   7.573 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -124.20  -59.91  -40.93  -36.47  -20.82  828.50 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -130.3000  -65.0200  -48.8900  -49.1700  -32.2300   -0.1967 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -203.80 -107.70  -79.82  -76.46  -51.56  760.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -208.0000 -114.2000  -89.0700  -89.4000  -63.7500   -0.3933 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -351.5  -199.2  -160.5  -151.0  -115.6   761.2 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -357.800 -206.300 -168.600 -167.900 -130.900   -3.043 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -603.1  -372.2  -315.9  -307.5  -256.0   645.9 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -609.70 -380.20 -324.70 -325.60 -270.10  -20.04 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1051.0  -710.7  -634.6  -619.5  -554.9   594.5 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1066.000  -720.700  -643.500  -639.600  -565.700    -6.847 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1547.0 -1094.0  -989.7  -967.3  -885.9   766.2 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1550.000 -1104.000 -1002.000  -990.800  -899.500    -5.501 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -2206.0 -1715.0 -1565.0 -1538.0 -1422.0   522.2 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -2206.00 -1724.00 -1579.00 -1561.00 -1437.00   -95.65

##    rndScore      ct      per
## 1        -1  911328      2.9
## 2         0 1146192      2.3
## 3         1  465048      5.6
## 4         2     948   2741.5
## 5         3   65148     39.9
## 6         4    4952    524.8
## 7         6    3744    694.2
## 8        17     752   3456.1
## 9        18      52  49980.0
## 10       19     132  19689.1
## 11       24     624   4165.0
## 12       49      36  72193.3
## 13      799       4 649740.0
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
## 
##  Summary of JB 75 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2210   18087    9505   81927   18885    3845 
## 
##      1 
## 134459 
## 
## [1] "JB 75: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6472  -0.5235  -0.1967  -0.0385  -0.0426 799.0000 
## [1] "Overall Return: 0.961472"
## 
## [1] "JB 75: Variances (Deal, Draw)"
## [1] "Deal Variance: 1.8637"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     2.260     3.256    17.310     4.380 13300.000

## 
## 
## This will assess the JB 75 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 
## 4 6 5 
## 5 4 6 
## 6 3 7 
## 7 2 8 
## 8 1 9 
## 9 0 10 11 12 13 
## 10 24 16 17 18 19 20 21 22 23 24 25 26 27 
## [1] 1270
##  num [1:1270, 1:10] 0 0 0 0 33 ...
##      rSum  ct
## 1       1   6
## 2      47  34
## 3    1081 105
## 4   16215  95
## 5  178365 155
## 6 1533939 875
##  chr [1:134459] "0-0-0-0-0-0-0-0-0-1" "0-0-0-0-0-0-0-0-0-1" ...
##  chr [1:1270] "0-0-0-0-0-0-0-0-0-1" "0-0-0-1-0-0-0-0-0-0" ...
##  int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
##  num [1:1270(1d)] 624 3744 54912 123552 96 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1270] "1" "2" "3" "4" ...

## [1] 0.9614721
## [1] 17.3082
##    scoreType    occPer   contRet    occFreq
## 2        799 40170.000  0.019889 0.00002489
## 3         49  9279.000  0.005281 0.00010777
## 10        24   423.300  0.056691 0.00236214
## 4          6    86.870  0.069065 0.01151088
## 5          4    91.710  0.043615 0.01090370
## 6          3    88.640  0.033845 0.01128179
## 7          2    13.440  0.148863 0.07443153
## 8          1     7.737  0.129254 0.12925441
## 9          0     4.649  0.000000 0.21509062
## 1         -1     1.835 -0.545032 0.54503227
## 
## Printed table suggests JB 75 mean return: 0.961471 and overall variance: 19.17006 
## 
## List of 1
##  $ : int [1:10] 1 2 3 4 5 6 7 8 9 10
## 
##    1 
## 1270 
##  int [1:10, 1] 1 2 3 4 5 6 7 8 9 10
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 10 
## 
## Moving to assess the: 10 rows of outcomes
## 
## 
## Mean: 0.9614721      Variance: 19.1719 
## List of 3
##  $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1270 
##  int [1:1000, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 105 
## 
## Moving to assess the: 105 rows of outcomes
##  num [1:1270, 1:3, 1:3] 0 0 0 0 0 ...
##  num [1:1270, 1:3] 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 ...
## [1] 100
## 
## 
## Mean: 0.9614721      Variance: 68.69794 
## List of 5
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1270 
##  int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 377 
## 
## Moving to assess the: 377 rows of outcomes
##  num [1:1270, 1:225] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0.00 0.00 1.47e-05 0.00 3.49e-07 ...
## [1] 100
##  num [1:1270, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1270, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## 
## 
## Mean: 0.9614721      Variance: 133.1336 
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:100000] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1270 
##  int [1:100000, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 377 
## 
## Moving to assess the: 377 rows of outcomes
##  num [1:1270, 1:225] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0.00 0.00 1.47e-05 0.00 3.49e-07 ...
## [1] 100
##  num [1:1270, 1:420] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1270, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1270] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
## 
## 
## Mean: 0.9614721      Variance: 359.4525 
## 
## Mean base return per hand: 0.9614556 with total variance: 359.104
## Mean return per hand: 96.145% with total variance (sd as % of total bet): 5,493,920 ( 1.46% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0653 -0.0593 -0.0550 -0.0480 -0.0402 -0.0304 -0.0216 -0.0138  0.0105

## 
## Mean base return per hand: 0.9614682 with total variance: 133.1136
## Mean return per hand: 96.1% with total variance (sd as % of total bet): 2,073,370 ( 1.8% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0730 -0.0659 -0.0605 -0.0509 -0.0407 -0.0290 -0.0158 -0.0071  0.0138

##  num [1:1270, 1:10] 0 0 0 0 0.702 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:10] "" "" "" "" ...
## [1] TRUE
## [1] TRUE
proc.time() - startTime
##    user  system elapsed 
##  108.01    9.87  118.26
# Define the paytable and simulate the holds (BP 65)
startTime <- proc.time()
bp65hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                 799, 49,  5,  4,  3, 
                                                   2,  1,  0,  0,  0, 
                                                   0, -1, -1, 79, 79, 
                                                  79, 39, 39, 39, 39, 
                                                  24, 24, 24, 24, 24
                                            )
                        )
bp65GameData <- genGame(hnd2Score=bp65hnd2Score, useGameName="BP 65")
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.6676  -1.0000 799.0000 
## 
## # A tibble: 12 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  337920
## 3        1  123552
## 4        2   54912
## 5        3   10200
## 6        4    5108
## 7        5    3744
## 8       24     432
## 9       39     144
## 10      49      36
## 11      79      48
## 12     799       4
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.0000 -0.9375 -0.8750 -0.6676 -0.6250 79.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9107 -0.8138 -0.8138 -0.6676 -0.6624  5.3270 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8150 -0.7751 -0.6926 -0.6676 -0.6534  0.6196 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7207 -0.7108 -0.7108 -0.6676 -0.5726 -0.5623 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6461  -0.5213  -0.2068  -0.0313  -0.0426 799.0000 
## 
## [1] 0.9686872

## [1] "Game BP 65:  Return: 0.96869 and Variance on Deal: 2.044"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -73.780 -32.060 -18.760 -15.100  -3.151 785.500 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -76.110 -36.610 -26.350 -26.680 -15.540   9.516 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -121.40  -54.14  -35.05  -28.94  -12.17  833.40 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -128.100  -60.520  -43.950  -44.580  -27.110    0.506 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -194.80  -96.23  -67.84  -62.52  -36.01  775.00 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -195.1000 -103.8000  -78.8900  -79.2800  -52.7800    0.2417 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -340.40 -174.50 -131.90 -122.00  -83.02  786.70 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -340.400 -183.000 -144.900 -144.000 -105.000    2.319 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -551.4  -322.3  -260.9  -250.6  -195.5   694.8 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -553.900 -332.200 -276.300 -274.600 -216.100   -8.072 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -930.6  -605.3  -524.1  -505.4  -429.7   750.3 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -939.100 -618.800 -537.700 -531.500 -451.500   -7.027 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1386.0  -926.1  -813.1  -787.9  -693.9   942.2 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1424.000  -942.700  -826.800  -819.000  -715.000    -5.373 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1998.0 -1437.0 -1274.0 -1249.0 -1116.0   886.4 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1998.00 -1453.00 -1294.00 -1281.00 -1138.00   -82.87

##    rndScore      ct      per
## 1        -1  911328      2.9
## 2         0 1146192      2.3
## 3         1  465048      5.6
## 4         2     948   2741.5
## 5         3   48252     53.9
## 6         4   17624    147.5
## 7         5    7968    326.2
## 8        17     752   3456.1
## 9        18      52  49980.0
## 10       19     132  19689.1
## 11       24     432   6016.1
## 12       39     144  18048.3
## 13       49      36  72193.3
## 14       79      48  54145.0
## 15      799       4 649740.0
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
## 
##  Summary of BP 65 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2186   18087    9533   81915   18893    3845 
## 
##      1 
## 134459 
## 
## [1] "BP 65: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6461  -0.5213  -0.2068  -0.0313  -0.0426 799.0000 
## [1] "Overall Return: 0.968687"
## 
## [1] "BP 65: Variances (Deal, Draw)"
## [1] "Deal Variance: 2.0442"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     2.214     3.140    18.610     5.778 13300.000

## 
## 
## This will assess the BP 65 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 
## 4 5 5 
## 5 4 6 
## 6 3 7 
## 7 2 8 
## 8 1 9 
## 9 0 10 11 12 13 
## 10 79 16 17 18 
## 11 39 19 20 21 22 
## 12 24 23 24 25 26 27 
## [1] 1648
##  num [1:1648, 1:12] 0 0 0 0 0 0 0 0 0 33 ...
##      rSum  ct
## 1       1   8
## 2      47  34
## 3    1081 107
## 4   16215  95
## 5  178365 451
## 6 1533939 953
##  chr [1:134459] "0-0-0-0-0-0-0-0-0-1-0-0" ...
##  chr [1:1648] "0-0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-0-0-1-0" ...
##  int [1:134459] 1 1 1 1 1 1 1 1 1 1 ...
##  num [1:1648(1d)] 48 144 432 288 3456 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1648] "1" "2" "3" "4" ...

## [1] 0.9686872
## [1] 18.61045
##    scoreType    occPer   contRet    occFreq
## 2        799 40240.000  0.019858 0.00002485
## 10        79  4987.000  0.015840 0.00020050
## 3         49  9290.000  0.005274 0.00010764
## 11        39  1897.000  0.020563 0.00052725
## 12        24   610.100  0.039338 0.00163910
## 4          5    87.670  0.057035 0.01140691
## 5          4    91.750  0.043598 0.01089956
## 6          3    88.690  0.033825 0.01127493
## 7          2    13.420  0.149061 0.07453069
## 8          1     7.737  0.129254 0.12925390
## 9          0     4.647  0.000000 0.21517583
## 1         -1     1.835 -0.544959 0.54495884
## 
## Printed table suggests BP 65 mean return: 0.968687 and overall variance: 20.65249 
## 
## List of 1
##  $ : int [1:12] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1648 
##  int [1:12, 1] 1 2 3 4 5 6 7 8 9 10 ...
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 12 
## 
## Moving to assess the: 12 rows of outcomes
## 
## 
## Mean: 0.9686872      Variance: 20.65466 
## List of 3
##  $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1728] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1728] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1648 
##  int [1:1728, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 189 
## 
## Moving to assess the: 189 rows of outcomes
##  num [1:1648, 1:3, 1:6] 0 0 0 0 0 ...
##  num [1:1648, 1:6] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## 
## 
## Mean: 0.9686872      Variance: 74.22922 
## List of 5
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1648 
##  int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 711 
## 
## Moving to assess the: 711 rows of outcomes
##  num [1:1648, 1:1140] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1648, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1648, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:1648, 1:320] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1648, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1648, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1648, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## 
## 
## Mean: 0.9686872      Variance: 144.1575 
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:248832] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1648 
##  int [1:248832, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 711 
## 
## Moving to assess the: 711 rows of outcomes
##  num [1:1648, 1:1140] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1648, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1648, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:1648, 1:320] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1648, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1648, 1:180] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1648, 1:5] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1648] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
## 
## 
## Mean: 0.9686872      Variance: 390.5254 
## 
## Mean base return per hand: 0.9686707 with total variance: 390.1796
## Mean return per hand: 96.864% with total variance (sd as % of total bet): 5,944,448 ( 1.52% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0602 -0.0532 -0.0490 -0.0414 -0.0330 -0.0228 -0.0138 -0.0057  0.0188

## 
## Mean base return per hand: 0.9686833 with total variance: 144.138
## Mean return per hand: 96.816% with total variance (sd as % of total bet): 2,269,576 ( 1.88% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0679 -0.0603 -0.0553 -0.0439 -0.0332 -0.0213 -0.0079  0.0008  0.0245

##  num [1:1648, 1:12] 0 0 0 0 0 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:12] "" "" "" "" ...
## [1] TRUE
## [1] TRUE
proc.time() - startTime
##    user  system elapsed 
##  152.85   14.18  167.71
# Define the paytable and simulate the holds (DDB 95)
startTime <- proc.time()
ddb95hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                  799, 49,  8,  4,  3, 
                                                    2,  0,  0,  0,  0, 
                                                    0, -1, -1, 399, 159, 
                                                  159, 159, 159, 79, 79, 
                                                   49, 49, 49, 49, 49
                                             )
                         )
ddb95GameData <- genGame(hnd2Score=ddb95hnd2Score, useGameName="DDB 95")
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.7007  -1.0000 799.0000 
## 
## # A tibble: 11 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  461472
## 3        2   54912
## 4        3   10200
## 5        4    5108
## 6        8    3744
## 7       49     468
## 8       79     108
## 9      159      72
## 10     399      12
## 11     799       4
## 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -0.9375  -0.8750  -0.7007  -0.7500 219.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9337 -0.8367 -0.8367 -0.7007 -0.6854 11.2200 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8501 -0.8094 -0.7277 -0.7007 -0.6885  0.8302 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7493 -0.7476 -0.7450 -0.7007 -0.6095 -0.5763 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6788  -0.5428  -0.2668  -0.0213  -0.0426 799.0000 
## 
## [1] 0.9787294

## [1] "Game DDB 95:  Return: 0.97873 and Variance on Deal: 4.789"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -84.160 -35.300 -18.780 -10.540   3.534 793.900 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -86.45  -42.57  -29.85  -30.51  -17.04   18.42 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -140.800  -58.980  -32.900  -18.140    2.836  854.900 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -151.4000  -68.6800  -47.0900  -48.9400  -26.5800    0.9119 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -226.60  -99.92  -60.32  -43.87  -11.93  833.20 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -227.00 -115.00  -81.15  -82.90  -46.91    2.13 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -381.30 -171.30 -106.30  -80.63  -23.69 1033.00 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -381.300 -190.300 -137.100 -138.900  -84.870    4.366 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -614.70 -296.40 -198.90 -173.20  -86.01  885.60 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -624.4000 -324.5000 -246.3000 -244.2000 -157.6000   -0.0123 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -992.9  -534.9  -383.8  -347.5  -206.4  1275.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1006.000  -568.400  -441.500  -430.800  -290.400     1.503 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1380.0  -790.0  -584.9  -539.8  -333.8  1321.0 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1392.00  -830.00  -646.10  -636.80  -451.80    -0.86 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -2122.0 -1154.0  -875.7  -849.9  -597.6  1695.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -2137.000 -1213.000  -958.300  -954.100  -714.200    -5.543

##    rndScore      ct      per
## 1        -1  951324      2.7
## 2         0 1359276      1.9
## 3         1  211968     12.3
## 4         2     948   2741.5
## 5         3   10236    253.9
## 6         4   42968     60.5
## 7         6    5760    451.2
## 8         7    6912    376.0
## 9         8    3456    752.0
## 10       11    1992   1304.7
## 11       12    2520   1031.3
## 12       17     752   3456.1
## 13       18      52  49980.0
## 14       19     132  19689.1
## 15       49     468   5553.3
## 16       99     108  24064.4
## 17      159      36  72193.3
## 18      220      36  72193.3
## 19      399      12 216580.0
## 20      799       4 649740.0
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
## 
##  Summary of DDB 95 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2150   19722    9447   72794   27912    2434 
## 
##      1 
## 134459 
## 
## [1] "DDB 95: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6788  -0.5428  -0.2668  -0.0213  -0.0426 799.0000 
## [1] "Overall Return: 0.978729"
## 
## [1] "DDB 95: Variances (Deal, Draw)"
## [1] "Deal Variance: 4.7887"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     5.033     8.414    37.380    19.970 13300.000

## 
## 
## This will assess the DDB 95 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 23 24 25 26 27 
## 4 8 5 
## 5 4 6 
## 6 3 7 
## 7 2 8 
## 8 0 9 10 11 12 13 
## 9 399 16 
## 10 159 17 18 19 20 
## 11 79 21 22 
## [1] 1257
##  num [1:1257, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##      rSum  ct
## 1       1   7
## 2      47  38
## 3    1081 112
## 4   16215  91
## 5  178365 513
## 6 1533939 496
##  chr [1:134459] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-1-0-0" ...
##  chr [1:1257] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-12-35-0" ...
##  int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
##  num [1:1257(1d)] 12 36 36 108 468 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1257] "1" "2" "3" "4" ...

## [1] 0.9787294
## [1] 37.37838
##    scoreType    occPer   contRet    occFreq
## 2        799 40070.000  0.019942 0.00002496
## 9        399 16230.000  0.024587 0.00006162
## 10       159  3157.000  0.050367 0.00031677
## 11        79  2601.000  0.030370 0.00038443
## 3         49   575.100  0.085200 0.00173877
## 4          8    92.010  0.086946 0.01086828
## 5          4    91.110  0.043904 0.01097590
## 6          3    77.270  0.038827 0.01294222
## 7          2    13.270  0.150681 0.07534037
## 8          0     2.983  0.000000 0.33525350
## 1         -1     1.811 -0.552093 0.55209319
## 
## Printed table suggests DDB 95 mean return: 0.978731 and overall variance: 42.1674 
## 
## List of 1
##  $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1257 
##  int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 11 
## 
## Moving to assess the: 11 rows of outcomes
## 
## 
## Mean: 0.9787294      Variance: 42.16708 
## List of 3
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1257 
##  int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 200 
## 
## Moving to assess the: 200 rows of outcomes
##  num [1:1257, 1:3, 1:3] 0 0 0 0 0 ...
##  num [1:1257, 1:3] 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 ...
## [1] 100
##  num [1:1257, 1:3, 1] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257, 1] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
## 
## 
## Mean: 0.9787294      Variance: 155.2334 
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1257 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1041 
## 
## Moving to assess the: 1041 rows of outcomes
##  num [1:1257, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1257, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1257, 1:10] 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 ...
## [1] 300
##  num [1:1257, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1257, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1257, 1:360] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1257, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:1257, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:1257, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
##  num [1:1257, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.9787294      Variance: 306.6094 
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1257 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1041 
## 
## Moving to assess the: 1041 rows of outcomes
##  num [1:1257, 1:200] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1257, 1:240] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1257, 1:10] 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 ...
## [1] 300
##  num [1:1257, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1257, 1:145] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1257, 1:360] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1257, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:1257, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:1257, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
##  num [1:1257, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1257] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.9787294      Variance: 852.6538 
## 
## Mean base return per hand: 0.9787112 with total variance: 852.2933
## Mean return per hand: 97.873% with total variance (sd as % of total bet): 13,244,178 ( 2.27% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0672 -0.0555 -0.0484 -0.0370 -0.0229 -0.0074  0.0080  0.0184  0.0390

## 
## Mean base return per hand: 0.9787235 with total variance: 306.5758
## Mean return per hand: 97.792% with total variance (sd as % of total bet): 4,950,816 ( 2.78% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0811 -0.0666 -0.0569 -0.0407 -0.0237 -0.0046  0.0139  0.0236  0.0543

##  num [1:1257, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:11] "" "" "" "" ...
## [1] TRUE
## [1] TRUE
proc.time() - startTime
##    user  system elapsed 
##  160.07   18.58  179.26
# Define the paytable and simulate the holds (DDB 85)
startTime <- proc.time()
ddb85hnd2Score <- data.frame(idx=gameIndex, val=c( -1, 
                                                  799, 49,  7,  4,  3, 
                                                    2,  0,  0,  0,  0, 
                                                    0, -1, -1, 399, 159, 
                                                  159, 159, 159, 79, 79, 
                                                   49, 49, 49, 49, 49
                                             )
                         )
ddb85GameData <- genGame(hnd2Score=ddb85hnd2Score, useGameName="DDB 85")
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -1.0000  -1.0000  -0.7022  -1.0000 799.0000 
## 
## # A tibble: 11 × 2
##    aScores      ct
##      <dbl>   <int>
## 1       -1 2062860
## 2        0  461472
## 3        2   54912
## 4        3   10200
## 5        4    5108
## 6        7    3744
## 7       49     468
## 8       79     108
## 9      159      72
## 10     399      12
## 11     799       4
## 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -1.0000  -0.9375  -0.8750  -0.7022  -0.7500 219.0000 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.9337 -0.8367 -0.8367 -0.7022 -0.6854 11.1600 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.8510 -0.8103 -0.7286 -0.7022 -0.6894  0.8204 
## 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.7507 -0.7490 -0.7465 -0.7022 -0.6109 -0.5777 
## 
## 
## [1] 0
## [1] 0
## [1] 0
## [1] 0
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6802  -0.5439  -0.2770  -0.0321  -0.0426 799.0000 
## 
## [1] 0.9678614

## [1] "Game DDB 85:  Return: 0.96786 and Variance on Deal: 4.75"
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -88.410 -40.500 -24.170 -15.980  -2.611 788.900 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -90.62  -46.80  -33.51  -34.12  -20.19   16.34 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -149.400  -69.270  -44.050  -29.000   -8.721  842.500 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -159.8000  -77.5300  -55.9600  -56.6500  -34.0700    0.6237 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -247.20 -121.50  -82.05  -65.62  -33.66  813.90 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -247.700 -133.300  -99.450  -99.180  -62.520    1.031 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -423.50 -214.70 -149.50 -124.10  -68.28  992.50 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -423.500 -230.900 -175.300 -173.200 -118.000    2.294 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  -695.7  -384.2  -287.0  -260.3  -174.2   800.9 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -704.3000 -405.8000 -323.5000 -316.5000 -230.9000   -0.0236 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1159.0  -707.8  -557.0  -521.5  -381.9  1098.0 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -1171.000  -733.100  -603.000  -582.600  -443.100    -8.958 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1653.0 -1061.0  -855.9  -811.6  -609.8  1042.0 
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -1659.00 -1088.00  -901.90  -880.50  -688.80    -6.66 
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   -2532   -1587   -1314   -1285   -1033    1257 
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
## -2538.000 -1628.000 -1370.000 -1355.000 -1113.000    -6.046

##    rndScore      ct      per
## 1        -1  951324      2.7
## 2         0 1359276      1.9
## 3         1  211968     12.3
## 4         2     948   2741.5
## 5         3   10236    253.9
## 6         4   42968     60.5
## 7         6   12672    205.1
## 8         7    3456    752.0
## 9        11    1992   1304.7
## 10       12    2520   1031.3
## 11       17     752   3456.1
## 12       18      52  49980.0
## 13       19     132  19689.1
## 14       49     468   5553.3
## 15       99     108  24064.4
## 16      159      36  72193.3
## 17      220      36  72193.3
## 18      399      12 216580.0
## 19      799       4 649740.0
## [1] 2598960      27
## [1] 270725     27
## [1] 22100    27
## [1] 1326   27
## [1] 52 27
## [1]  1 27
##      idx       0 1  2    3    4     5     6      7     8     9    10    11
## [1,]   0 1302540 4 36 3744 5108 10200 54912 123552 84480 84480 84480 84480
##         12     13 14 15 16 17 18 19 20 21 22 23 24  25
## [1,] 84480 675840 12 12 24 12 24 36 72 12 36 24 72 288
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 0
## [1] 1
## 
##  Summary of DDB 85 starting with row sums
## 
##       1      47    1081   16215  178365 1533939 
##    2150   19722    9477   72838   27838    2434 
## 
##      1 
## 134459 
## 
## [1] "DDB 85: Overall EV and Mean"
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
##  -0.6802  -0.5439  -0.2770  -0.0321  -0.0426 799.0000 
## [1] "Overall Return: 0.967861"
## 
## [1] "DDB 85: Variances (Deal, Draw)"
## [1] "Deal Variance: 4.75"
## [1] "Draw Variance Summary Statistics"
##      Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
##     0.000     5.006     8.255    37.240    19.940 13300.000

## 
## 
## This will assess the DDB 85 means and variances
## 
## 1 -1 2 14 15 
## 2 799 3 
## 3 49 4 23 24 25 26 27 
## 4 7 5 
## 5 4 6 
## 6 3 7 
## 7 2 8 
## 8 0 9 10 11 12 13 
## 9 399 16 
## 10 159 17 18 19 20 
## 11 79 21 22 
## [1] 1256
##  num [1:1256, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##      rSum  ct
## 1       1   7
## 2      47  38
## 3    1081 112
## 4   16215  91
## 5  178365 512
## 6 1533939 496
##  chr [1:134459] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-1-0-0" ...
##  chr [1:1256] "0-0-0-0-0-0-0-0-1-0-0" "0-0-0-0-0-0-0-0-12-35-0" ...
##  int [1:134459] 1 1 1 2 2 2 2 2 2 2 ...
##  num [1:1256(1d)] 12 36 36 108 468 ...
##  - attr(*, "dimnames")=List of 1
##   ..$ : chr [1:1256] "1" "2" "3" "4" ...

## [1] 0.9678614
## [1] 37.24483
##    scoreType    occPer   contRet    occFreq
## 2        799 40070.000  0.019942 0.00002496
## 9        399 16240.000  0.024570 0.00006158
## 10       159  3158.000  0.050346 0.00031664
## 11        79  2601.000  0.030370 0.00038443
## 3         49   574.900  0.085225 0.00173928
## 4          7    92.020  0.076074 0.01086765
## 5          4    91.030  0.043941 0.01098528
## 6          3    77.210  0.038853 0.01295109
## 7          2    13.270  0.150669 0.07533427
## 8          0     2.983  0.000000 0.33520671
## 1         -1     1.811 -0.552128 0.55212811
## 
## Printed table suggests DDB 85 mean return: 0.967862 and overall variance: 41.99557 
## 
## List of 1
##  $ : int [1:11] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1256 
##  int [1:11, 1] 1 2 3 4 5 6 7 8 9 10 ...
##      [,1]
## [1,]    1
## [2,]    2
## [3,]    3
## [4,]    4
## [5,]    5
## [6,]    6
## 
## 
## Number of unique outcome types: 11 
## 
## Moving to assess the: 11 rows of outcomes
## 
## 
## Mean: 0.9678614      Variance: 41.99487 
## List of 3
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:1331] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1256 
##  int [1:1331, 1:3] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3]
## [1,]    1    1    1
## [2,]    1    1    2
## [3,]    1    1    3
## [4,]    1    1    4
## [5,]    1    1    5
## [6,]    1    1    6
## 
## 
## Number of unique outcome types: 199 
## 
## Moving to assess the: 199 rows of outcomes
##  num [1:1256, 1:3, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256, 1:3] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
## 
## 
## Mean: 0.9678614      Variance: 154.4849 
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1256 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1017 
## 
## Moving to assess the: 1017 rows of outcomes
##  num [1:1256, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1256, 1:270] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1256, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:1256, 1:140] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1256, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1256, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1256, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:1256, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:1256, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
##  num [1:1256, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.9678614      Variance: 304.9752 
## [1] "nPlay 10 assessed using nPlay 5 frequencies appropriately multiplied/summed"
## List of 5
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 1 1 1 1 1 1 1 1 1 ...
##  $ : int [1:161051] 1 2 3 4 5 6 7 8 9 10 ...
## 
##    1 
## 1256 
##  int [1:161051, 1:5] 1 1 1 1 1 1 1 1 1 1 ...
##      [,1] [,2] [,3] [,4] [,5]
## [1,]    1    1    1    1    1
## [2,]    1    1    1    1    2
## [3,]    1    1    1    1    3
## [4,]    1    1    1    1    4
## [5,]    1    1    1    1    5
## [6,]    1    1    1    1    6
## 
## 
## Number of unique outcome types: 1017 
## 
## Moving to assess the: 1017 rows of outcomes
##  num [1:1256, 1:150] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 100
##  num [1:1256, 1:270] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 200
##  num [1:1256, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 300
##  num [1:1256, 1:140] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 400
##  num [1:1256, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 500
##  num [1:1256, 1:60] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 600
##  num [1:1256, 1:90] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 700
##  num [1:1256, 1:120] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 800
##  num [1:1256, 1:30] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 900
##  num [1:1256, 1:20] 0 0 0 0 0 0 0 0 0 0 ...
##  num [1:1256] 0 0 0 0 0 0 0 0 0 0 ...
## [1] 1000
## 
## 
## Mean: 0.9678614      Variance: 847.4523 
## 
## Mean base return per hand: 0.967845 with total variance: 847.1118
## Mean return per hand: 96.786% with total variance (sd as % of total bet): 13,179,550 ( 2.27% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0778 -0.0664 -0.0591 -0.0478 -0.0337 -0.0182 -0.0027  0.0076  0.0281

## 
## Mean base return per hand: 0.9678563 with total variance: 304.943
## Mean return per hand: 96.706% with total variance (sd as % of total bet): 4,923,107 ( 2.77% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0913 -0.0773 -0.0677 -0.0516 -0.0344 -0.0156  0.0027  0.0124  0.0437

##  num [1:1256, 1:11] 0 0 0 0 0 0 0 0 0 0 ...
##  - attr(*, "dimnames")=List of 2
##   ..$ : NULL
##   ..$ : chr [1:11] "" "" "" "" ...
## [1] TRUE
## [1] TRUE
proc.time() - startTime
##    user  system elapsed 
##  156.88   18.07  175.44

Next, the 10-play version of each is simulated for 12k deals (non-STP). Results are again cached for run-time performance:

jb85_10p_12k_fullmin_base <- sim_NPlay(keyFrame=jb85GameData$game_10Play$out10Play, 
                                       useName="JB 85", nPlay=10, nHands=12000, nSims=4000, 
                                       genCumMin=TRUE, genFullMin=TRUE
                                       )
## 
## Mean base return per hand: 0.9729679 with total variance: 364.1599
## Mean return per hand: 97.338% with total variance (sd as % of total bet): 4,516,990 ( 1.77% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0597 -0.0505 -0.0459 -0.0380 -0.0288 -0.0180 -0.0063  0.0029  0.0372

jb75_10p_12k_fullmin_base <- sim_NPlay(keyFrame=jb75GameData$game_10Play$out10Play, 
                                       useName="JB 75", nPlay=10, nHands=12000, nSims=4000, 
                                       genCumMin=TRUE, genFullMin=TRUE
                                       )
## 
## Mean base return per hand: 0.9614556 with total variance: 359.104
## Mean return per hand: 96.132% with total variance (sd as % of total bet): 4,234,183 ( 1.71% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0709 -0.0621 -0.0576 -0.0499 -0.0404 -0.0302 -0.0187 -0.0108  0.0261

bp65_10p_12k_fullmin_base <- sim_NPlay(keyFrame=bp65GameData$game_10Play$out10Play, 
                                       useName="BP 65", nPlay=10, nHands=12000, nSims=4000, 
                                       genCumMin=TRUE, genFullMin=TRUE
                                       )
## 
## Mean base return per hand: 0.9686707 with total variance: 390.1796
## Mean return per hand: 96.814% with total variance (sd as % of total bet): 4,699,097 ( 1.81% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0662 -0.0576 -0.0522 -0.0434 -0.0332 -0.0227 -0.0112 -0.0029  0.0340

ddb95_10p_12k_fullmin_base <- sim_NPlay(keyFrame=ddb95GameData$game_10Play$out10Play, 
                                        useName="DDB 95", nPlay=10, nHands=12000, nSims=4000, 
                                        genCumMin=TRUE, genFullMin=TRUE
                                        )
## 
## Mean base return per hand: 0.9787112 with total variance: 852.2933
## Mean return per hand: 97.812% with total variance (sd as % of total bet): 10,126,608 ( 2.65% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0742 -0.0621 -0.0539 -0.0401 -0.0242 -0.0055  0.0126  0.0251  0.0490

ddb85_10p_12k_fullmin_base <- sim_NPlay(keyFrame=ddb85GameData$game_10Play$out10Play, 
                                        useName="DDB 85", nPlay=10, nHands=12000, nSims=4000, 
                                        genCumMin=TRUE, genFullMin=TRUE
                                        )
## 
## Mean base return per hand: 0.967845 with total variance: 847.1118
## Mean return per hand: 96.748% with total variance (sd as % of total bet): 10,090,584 ( 2.65% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0868 -0.0722 -0.0646 -0.0508 -0.0347 -0.0164  0.0014  0.0141  0.0434

The the RR (survival) curves are plotted:

graphRRSurvival(keyData=jb85_10p_12k_fullmin_base$fullminNPlay, 
                keyName="JB 85 10-play", keyBanks=seq(800, 4800, by=800)
                )

graphRRSurvival(keyData=jb75_10p_12k_fullmin_base$fullminNPlay, 
                keyName="JB 75 10-play", keyBanks=seq(800, 4800, by=800)
                )

graphRRSurvival(keyData=bp65_10p_12k_fullmin_base$fullminNPlay, 
                keyName="BP 65 10-play", keyBanks=seq(800, 4800, by=800)
                )

graphRRSurvival(keyData=ddb95_10p_12k_fullmin_base$fullminNPlay, 
                keyName="DDB 95 10-play", keyBanks=seq(800, 4800, by=800)
                )

graphRRSurvival(keyData=ddb85_10p_12k_fullmin_base$fullminNPlay, 
                keyName="DDB 85 10-play", keyBanks=seq(800, 4800, by=800)
                )

Next, several variants of JB (JB 95 1-play, JB 95 5-play STP, JB 85 10-play) and DDB (DDB 95 1-play, DDB 95 5-play STP, DDB 85 10-play) are simulated for 12k deals (non-STP). Results are again cached for run-time performance:

jb95_01p_12k_fullmin_base <- sim_NPlay(keyFrame=jb95GameData$game_01Play$dfOutcome, 
                                       useName="JB 95", nPlay=1, nHands=12000, nSims=4000, 
                                       genCumMin=TRUE, genFullMin=TRUE
                                       )
## 
## Mean base return per hand: 0.9844978 with total variance: 19.49537
## Mean return per hand: 98.464% with total variance (sd as % of total bet): 238,724 ( 4.07% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0717 -0.0611 -0.0544 -0.0432 -0.0284  0.0073  0.0412  0.0619  0.1107

jb95_05p_12k_fullmin_stp <- sim_NPlay(keyFrame=jb95GameData$game_05Play$dfOutcome, 
                                      useName="JB 95", nPlay=5, nHands=12000, nSims=4000, 
                                      genCumMin=TRUE, genFullMin=TRUE, runSTP=TRUE
                                      )
## 
## Mean base return per hand: 0.9844943 with total variance: 136.378
## Mean return per hand: 98.801% with total variance (sd as % of total bet): 4,038,004 ( 2.79% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0600 -0.0473 -0.0414 -0.0300 -0.0158  0.0004  0.0196  0.0356  0.0824

jb85_10p_12k_fullmin_base <- sim_NPlay(keyFrame=jb85GameData$game_10Play$out10Play, 
                                       useName="JB 85", nPlay=10, nHands=12000, nSims=4000, 
                                       genCumMin=TRUE, genFullMin=TRUE
                                       )
## 
## Mean base return per hand: 0.9729679 with total variance: 364.1599
## Mean return per hand: 97.275% with total variance (sd as % of total bet): 4,284,743 ( 1.72% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0588 -0.0514 -0.0471 -0.0386 -0.0290 -0.0181 -0.0069  0.0015  0.0337

ddb95_01p_12k_fullmin_base <- sim_NPlay(keyFrame=ddb95GameData$game_01Play$dfOutcome, 
                                        useName="DDB 95", nPlay=1, nHands=12000, nSims=4000, 
                                        genCumMin=TRUE, genFullMin=TRUE
                                        )
## 
## Mean base return per hand: 0.9787302 with total variance: 42.16757
## Mean return per hand: 97.852% with total variance (sd as % of total bet): 495,179 ( 5.86% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.1315 -0.1065 -0.0910 -0.0627 -0.0281  0.0139  0.0572  0.0828  0.1398

ddb95_05p_12k_fullmin_stp <- sim_NPlay(keyFrame=ddb95GameData$game_05Play$dfOutcome, 
                                       useName="DDB 95", nPlay=5, nHands=12000, nSims=4000, 
                                       genCumMin=TRUE, genFullMin=TRUE, runSTP=TRUE
                                       )
## 
## Mean base return per hand: 0.9787235 with total variance: 306.5758
## Mean return per hand: 98.132% with total variance (sd as % of total bet): 8,700,098 ( 4.1% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0933 -0.0757 -0.0649 -0.0466 -0.0236  0.0039  0.0332  0.0551  0.1040

ddb85_10p_12k_fullmin_base <- sim_NPlay(keyFrame=ddb85GameData$game_10Play$out10Play, 
                                        useName="DDB 85", nPlay=10, nHands=12000, nSims=4000, 
                                        genCumMin=TRUE, genFullMin=TRUE
                                        )
## 
## Mean base return per hand: 0.967845 with total variance: 847.1118
## Mean return per hand: 96.762% with total variance (sd as % of total bet): 9,981,042 ( 2.63% )
##      1%      5%     10%     25%     50%     75%     90%     95%     99% 
## -0.0850 -0.0713 -0.0639 -0.0507 -0.0346 -0.0163  0.0018  0.0134  0.0429

Then, the RR (survival) curves are plotted for JB, with 1-play (1 and 2) plotted twice for legends:

# 25k at 5k (0.6k-0.8k units for 100%, 0.4k units for 95%, 0.2k units for 50%)
# 50k at 10k (1.0k-1.2k units for 100%, 0.6k-0.8k units for 95%, 0.4k units for 50%)
graphRRSurvival(keyData=jb95_01p_12k_fullmin_base$fullminNPlay, 
                keyName="JB 95 1-play (base 1; 60k total)", 
                keyBanks=seq(200, 1200, by=200)
                )

# 25k at 3.3k (2.4k for 100%, 1.6k for 95%, <0.8k for 50%)
# 50k at 6.7k (4.0k for 100%, 2.4k for 95%, 0.8k - 1.6k for 50%)
graphRRSurvival(keyData=jb95_05p_12k_fullmin_stp$fullminNPlay, 
                keyName="JB 95 5-play STP (base 0.25; 90k total)", 
                keyBanks=seq(800, 4800, by=800)
                )

# 25k at 2.5k (0.5k units for 100%, 0.2k-0.3k units for 95%, 0.1k-0.2k units for 50%)
# 50k at 5k (>0.6k units for 100%, 0.4k units for 95%, 0.2k units for 50%)
graphRRSurvival(keyData=jb95_01p_12k_fullmin_base$fullminNPlay, 
                keyName="JB 95 1-play (base 2; 120k total)", 
                keyBanks=seq(100, 600, by=100)
                )

# 25k at 2k (2.4k units for 100%, 1.6k units for 95%, 0.8k units for 50%)
# 50k at 4k (4.0k units for 100%, 2.4k-3.2k units for 95%, 1.6k units for 50%)
graphRRSurvival(keyData=jb85_10p_12k_fullmin_base$fullminNPlay, 
                keyName="JB 85 10-play (base 0.25; 150k total)", 
                keyBanks=seq(800, 4800, by=800)
                )

And, RR (survival) curves are plotted for DDB, with 1-play (1 and 2) plotted twice for legends:

# 25k at 5k (1.2k units for 100%, 0.8k units for 95%, 0.2k-0.4k units for 50%)
# 50k at 10k (>1.2k units for 100%, 1.2k units for 95%, 0.6k units for 50%)
graphRRSurvival(keyData=ddb95_01p_12k_fullmin_base$fullminNPlay, 
                keyName="DDB 95 1-play (base 1; 60k total)", 
                keyBanks=seq(200, 1200, by=200)
                )

# 25k at 3.3k (4.0k for 100%, 2.4k for 95%, 0.8k-1.6k for 50%)
# 50k at 6.7k (>4.8k for 100%, 4.0k for 95%, 1.6k for 50%)
graphRRSurvival(keyData=ddb95_05p_12k_fullmin_stp$fullminNPlay, 
                keyName="DDB 95 5-play STP (base 0.25; 90k total)", 
                keyBanks=seq(800, 4800, by=800)
                )

# 25k at 2.5k (>0.6k units for 100%, 0.5k units for 95%, 0.2k-0.3k units for 50%)
# 50k at 5k (>0.6k units for 100%, >0.6k units for 95%, 0.3k-0.4k units for 50%)
graphRRSurvival(keyData=ddb95_01p_12k_fullmin_base$fullminNPlay, 
                keyName="DDB 95 1-play (base 2; 120k total)", 
                keyBanks=seq(100, 600, by=100)
                )

# 25k at 2k (4.0k units for 100%, 2.4k units for 95%, 0.8k-1.6k units for 50%)
# 50k at 4k (>4.8k units for 100%, 4.0k units for 95%, 1.6k-2.4k units for 50%)
graphRRSurvival(keyData=ddb85_10p_12k_fullmin_base$fullminNPlay, 
                keyName="DDB 85 10-play (base 0.25; 150k total)", 
                keyBanks=seq(800, 4800, by=800)
                )

A variant of the graphRRSurvival() function is created that can plot multiple games, out to different # hands, and assess a particular risk of ruin for them:

library(stringr)

graphRRMultiGame <- function(keyList, keyLabel, keyBanks, keyDenom, grName,
                             keyPct=c(1, 0.95, 0.8, 0.5), 
                             keyCol=c("red", "orange", "purple", "blue", "grey", "green")
                             ) {

    # Check that data lengths are OK
    if ((length(keyList) != length(keyLabel)) | 
        (length(keyList) != length(keyBanks)) |
        (length(keyList) != length(keyDenom)) |
        (length(keyList) > length(keyCol))
        ) {
            cat("\nkeyList: ", length(keyList), " keyLabel: ", length(keyLabel), 
                " keyBanks: ", length(keyBanks), " keyCol: ", length(keyCol), 
                " keyDenom: ", length(keyDenom), "\n"
                )
            stop("Function will abort due to length mismatches:")            
        }
    
    # Survival Curves for each element of keyList
    mtxData <- matrix(data=NA, nrow=length(keyList), ncol=length(keyPct))
    for (listNum in 1:length(keyList)) {
        keyData <- keyList[[listNum]]
        nBank <- keyBanks[listNum]
        mtxSurv <- rowMeans(keyData > -nBank)
        if (listNum == 1) {
            plot(x=as.numeric(names(mtxSurv))/keyDenom[listNum], y=unname(mtxSurv), 
                 main=grName, 
                 xlab="% to Target", ylab="Survival", 
                 pch=19, col=keyCol[listNum], cex=0.5, 
                 ylim=c(0, 1), xlim=c(0, 1)
                 )
        } else {
            points(x=as.numeric(names(mtxSurv))/keyDenom[listNum], y=unname(mtxSurv), 
                   pch=19, col=keyCol[listNum], cex=0.5
            )
        }
        for (intCtr in seq_along(keyPct)) {
            mtxData[listNum, intCtr] <- 
                as.numeric(names(mtxSurv)[sum(mtxSurv >= keyPct[intCtr])]) / keyDenom[listNum]
        }
    }

    abline(h=keyPct, lty=2)
    topRow <- paste(str_pad("% Achd", width=7+max(nchar(keyLabel)), side="both"), "( ", 
                    paste(paste0(round(100*keyPct, 1), "%"), collapse="    |      "), 
                    " )"
                    )
    appData <- apply(pmin(mtxData, 1), 1, 
                     FUN=function(x) { 
                         paste(format(round(x*100, 1), nsmall=1, width=5), collapse="%   |   ")
                         } 
                     )
    legend("bottomleft", 
           legend=c(topRow, 
                    paste0(str_pad(keyLabel, width=max(nchar(keyLabel)), side="right"), 
                           "      ( ", appData, "% )"
                           )
                    ), 
           col=c("white", keyCol), cex=0.8, pch=19, pt.cex=1.2
           )

}

The algorithm is then attempted for a few primary methods of hitting the same coin-in:

  • JB 95 5-play (12,000 deals target with 2,400 units bank)
  • JB 95 5-play STP (10,000 deals target with 2,400 units bank)
  • JB 95 1-play (15,000 deals target with 600 units bank)
  • JB 85 10-play (6,000 deals target with 2,400 units bank)
  • JB 95 1-play (7,500 deals target with 300 units bank)
gmList <- list(jb95_05_bas_v1=jb95_05p_24k_fullmin$fullminNPlay, 
               jb95_05_stp_v1=jb95_05p_12k_fullmin_stp$fullminNPlay, 
               jb95_01_v1=jb95_01p_24k_fullmin$fullminNPlay, 
               jb85_10_v1=jb85_10p_12k_fullmin_base$fullminNPlay,             
               jb95_01_v2=jb95_01p_12k_fullmin_base$fullminNPlay
               )
gmLabel=c("JB 95 5-p", "JB 95 5-p STP", "JB 95 1-p (sm)", "JB 85 10-p", "JB 95 1-p (lg)")
gmDenom=c(12000, 10000, 15000, 6000, 7500)

# Run it for the 3k bank
gmBanks=c(2400, 2400, 600, 2400, 300)
graphRRMultiGame(keyList=gmList, keyLabel=gmLabel, keyBanks=gmBanks, 
                 keyDenom=gmDenom, grName="Survival Curves (Target=7.5k TC using 3k bank)",
                 keyPct=c(1, 0.99, 0.95, 0.8, 0.5)
                 )

# Run it for the 4k bank
gmBanks=c(3200, 3200, 800, 3200, 400)
graphRRMultiGame(keyList=gmList, keyLabel=gmLabel, keyBanks=gmBanks, 
                 keyDenom=gmDenom, grName="Survival Curves (Target=7.5k TC using 4k bank)",
                 keyPct=c(1, 0.99, 0.95, 0.8, 0.5)
                 )

# Run it for the 5k bank
gmBanks=c(4000, 4000, 1000, 4000, 500)
graphRRMultiGame(keyList=gmList, keyLabel=gmLabel, keyBanks=gmBanks, 
                 keyDenom=gmDenom, grName="Survival Curves (Target=7.5k TC using 5k bank)",
                 keyPct=c(1, 0.99, 0.95, 0.8, 0.5)
                 )

# Run it for the 2k bank
gmBanks=c(1600, 1600, 400, 1600, 200)
graphRRMultiGame(keyList=gmList, keyLabel=gmLabel, keyBanks=gmBanks, 
                 keyDenom=gmDenom, grName="Survival Curves (Target=7.5k TC using 2k bank)",
                 keyPct=c(1, 0.99, 0.95, 0.8, 0.5)
                 )